Fix all GHC warnings

dejafu/Test/DejaFu.hs

@@ -440,12 +440,13 @@ representative p xs = result { _failures = choose . collect $ _failures result }
   choose  = map $ minimumBy (comparing $ \(_, trc) -> (preEmpCount' trc, length trc))
 
   groupBy' res _ [] = res
-  groupBy' res eq (x:xs) = groupBy' (insert' eq x res) eq xs
+  groupBy' res eq (y:ys) = groupBy' (insert' eq y res) eq ys
 
-  insert' eq x [] = [[x]]
+  insert' _ x [] = [[x]]
   insert' eq x (ys@(y:_):yss)
     | x `eq` y  = (x:ys) : yss
     | otherwise = ys : insert' eq x yss
+  insert' _ _ ([]:_) = undefined
 
 -- | Check that a computation never aborts.
 abortsNever :: Predicate a

dejafu/Test/DejaFu/Deterministic/Internal.hs

@@ -57,6 +57,7 @@ module Test.DejaFu.Deterministic.Internal
  ) where
 
 import Control.Exception (MaskingState(..), SomeException(..))
+import Data.Functor (void)
 import Data.List (sort)
 import Data.List.Extra
 import Data.Maybe (fromJust, isJust, fromMaybe, isNothing, listToMaybe)
@@ -295,7 +296,7 @@ stepThread fixed runstm memtype action idSource tid threads wb caps = case actio
     stepModRefCas cref@(CRef crid _) f c = synchronised $ do
       tick@(Ticket _ _ old) <- readForTicket fixed cref tid
       let (new, val) = f old
-      casCRef fixed cref tid tick new
+      void $ casCRef fixed cref tid tick new
       simple (goto (c val) tid threads) $ ModRefCas crid
 
     -- | Write to a @CRef@ without synchronising
@@ -406,8 +407,8 @@ stepThread fixed runstm memtype action idSource tid threads wb caps = case actio
       threads' = goto a tid (mask m tid threads)
 
     -- | Reset the masking thread of the state.
-    stepResetMask b1 b2 m c = simple threads' action where
+    stepResetMask b1 b2 m c = simple threads' act where
-      action   = (if b1 then SetMasking else ResetMasking) b2 m
+      act      = (if b1 then SetMasking else ResetMasking) b2 m
       threads' = goto c tid (mask m tid threads)
 
     -- | Create a new @CVar@, using the next 'CVarId'.

dejafu/Test/DejaFu/Deterministic/Internal/Memory.hs

@@ -43,8 +43,8 @@ bufferWrite fixed (WriteBuffer wb) i cref@(CRef _ ref) new tid = do
   let buffer' = I.insertWith (><) i write wb
 
   -- Write the thread-local value to the @CRef@'s update map.
-  (map, count, def) <- readRef fixed ref
+  (locals, count, def) <- readRef fixed ref
-  writeRef fixed ref (M.insert tid new map, count, def)
+  writeRef fixed ref (M.insert tid new locals, count, def)
 
   return $ WriteBuffer buffer'
 
@@ -54,7 +54,7 @@ commitWrite fixed w@(WriteBuffer wb) i = case maybe EmptyL viewl $ I.lookup i wb
   BufferedWrite _ cref a :< rest -> do
     writeImmediate fixed cref a
     return . WriteBuffer $ I.insert i rest wb
-    
+
   EmptyL -> return w
 
 -- | Read from a @CRef@, returning a newer thread-local non-committed

dejafu/Test/DejaFu/Deterministic/Internal/Threading.hs

@@ -138,15 +138,15 @@ goto a = M.alter $ \(Just thread) -> Just (thread { _continuation = a })
 -- | Start a thread with the given ID, inheriting the masking state
 -- from the parent thread. This ID must not already be in use!
 launch :: ThreadId -> ThreadId -> ((forall b. M n r s b -> M n r s b) -> Action n r s) -> Threads n r s -> Threads n r s
-launch parent tid a threads = launch' mask tid a threads where
+launch parent tid a threads = launch' ms tid a threads where
-  mask = fromMaybe Unmasked $ _masking <$> M.lookup parent threads
+  ms = fromMaybe Unmasked $ _masking <$> M.lookup parent threads
 
 -- | Start a thread with the given ID and masking state. This must not already be in use!
 launch' :: MaskingState -> ThreadId -> ((forall b. M n r s b -> M n r s b) -> Action n r s) -> Threads n r s -> Threads n r s
-launch' mask tid a = M.insert tid thread where
+launch' ms tid a = M.insert tid thread where
-  thread = Thread { _continuation = a umask, _blocking = Nothing, _handlers = [], _masking = mask, _known = [], _fullknown = False }
+  thread = Thread { _continuation = a umask, _blocking = Nothing, _handlers = [], _masking = ms, _known = [], _fullknown = False }
 
-  umask mb = resetMask True Unmasked >> mb >>= \b -> resetMask False mask >> return b
+  umask mb = resetMask True Unmasked >> mb >>= \b -> resetMask False ms >> return b
   resetMask typ m = cont $ \k -> AResetMask typ True m $ k ()
 
 -- | Kill a thread.

dejafu/Test/DejaFu/SCT.hs

@@ -257,7 +257,7 @@ pbBound (PreemptionBound pb) ts dl = preEmpCount ts dl <= pb
 -- | Count the number of pre-emptions in a schedule prefix.
 preEmpCount :: [(Decision, ThreadAction)] -> (Decision, a) -> Int
 preEmpCount ts (d, _) = go Nothing ts where
-  go p ((d, a):rest) = preEmpC p d + go (Just a) rest
+  go p ((d', a):rest) = preEmpC p d' + go (Just a) rest
   go p [] = preEmpC p d
 
   preEmpC (Just Yield) (SwitchTo _) = 0
@@ -471,7 +471,7 @@ initialSchedState sleep prefix = SchedState
 bporSched :: MemType
   -> ([(Decision, ThreadAction)] -> Maybe (ThreadId, ThreadAction) -> NonEmpty (ThreadId, Lookahead) -> [ThreadId])
   -> Scheduler SchedState
-bporSched memtype init = force $ \s trc prior threads -> case _sprefix s of
+bporSched memtype initials = force $ \s trc prior threads -> case _sprefix s of
   -- If there is a decision available, make it
   (d:ds) ->
     let threads' = fmap (\(t,a:|_) -> (t,a)) threads
@@ -482,7 +482,7 @@ bporSched memtype init = force $ \s trc prior threads -> case _sprefix s of
   -- them arbitrarily (recording the others).
   [] ->
     let threads' = fmap (\(t,a:|_) -> (t,a)) threads
-        choices  = init trc prior threads'
+        choices  = initials trc prior threads'
         checkDep t a = case prior of
           Just (tid, act) -> dependent memtype unknownCRState (tid, act) (t, a)
           Nothing -> False

dejafu/Test/DejaFu/SCT/Internal.hs

@@ -188,8 +188,8 @@ findBacktrack memtype backtrack = go initialCRState S.empty initialThread [] . S
                  , let is = idxs' u n v tagged
                  , not $ null is]
 
-        idxs' u n v = mapMaybe go where
+        idxs' u n v = mapMaybe go' where
-          go (i, b)
+          go' (i, b)
             | _threadid b == v && (killsEarly || isDependent b) = Just i
             | otherwise = Nothing
 
@@ -254,8 +254,8 @@ todo bv = go initialThread [] where
     let todo' = [ x
                 | x@(t,c) <- M.toList $ _backtrack b
                 , let decision  = decisionOf (Just . activeTid $ map fst pref) (_brunnable bpor) t
-                , let lookahead = fromJust . M.lookup t $ _runnable b
+                , let lahead = fromJust . M.lookup t $ _runnable b
-                , bv pref (decision, lookahead)
+                , bv pref (decision, lahead)
                 , t `notElem` M.keys (_bdone bpor)
                 , c || M.notMember t (_bsleep bpor)
                 ]
@@ -319,7 +319,7 @@ dependent' _ _ (_, ThrowTo t) (t2, a)     = t == t2 && a /= WillStop
 dependent' _ _ (t2, a) (_, WillThrowTo t) = t == t2 && a /= Stop
 dependent' _ _ (_, STM _ _) (_, WillSTM) = True
 dependent' _ _ (_, GetNumCapabilities a) (_, WillSetNumCapabilities b) = a /= b
-dependent' _ _ (_, SetNumCapabilities a) (_, WillGetNumCapabilities)   = True
+dependent' _ _ (_, SetNumCapabilities _) (_, WillGetNumCapabilities)   = True
 dependent' _ _ (_, SetNumCapabilities a) (_, WillSetNumCapabilities b) = a /= b
 -- This is safe because, if the thread blocks anyway, a context switch
 -- will occur anyway so there's no point pre-empting the action.

dejafu/Test/DejaFu/STM/Internal.hs

@@ -108,9 +108,8 @@ doTransaction fixed ma idsource = do
         TStop  -> return (newIDSource, newUndo, newReaden, newWritten, TStop:newSofar)
         TRetry -> writeRef fixed ref Nothing
           >> return (newIDSource, newUndo, newReaden, newWritten, TRetry:newSofar)
-        TThrow -> writeRef fixed ref (Just . Left $ case act of SThrow e -> wrap e)
+        TThrow -> writeRef fixed ref (Just . Left $ case act of SThrow e -> wrap e; _ -> undefined)
           >> return (newIDSource, newUndo, newReaden, newWritten, TThrow:newSofar)
-
         _ -> go ref newAct newUndo newIDSource newReaden newWritten newSofar
 
     -- | This wraps up an uncaught exception inside a @SomeException@,