Print which warning-flag controls an emitted warning
[ghc.git] / compiler / main / GhcMake.hs
index 7bbe4be..1729a5b 100644 (file)
@@ -678,7 +678,7 @@ checkStability hpt sccs all_home_mods = foldl checkSCC ([],[]) sccs
 -- | Each module is given a unique 'LogQueue' to redirect compilation messages
 -- to. A 'Nothing' value contains the result of compilation, and denotes the
 -- end of the message queue.
-data LogQueue = LogQueue !(IORef [Maybe (Severity, SrcSpan, PprStyle, MsgDoc)])
+data LogQueue = LogQueue !(IORef [Maybe (WarnReason, Severity, SrcSpan, PprStyle, MsgDoc)])
                          !(MVar ())
 
 -- | The graph of modules to compile and their corresponding result 'MVar' and
@@ -879,7 +879,7 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do
             return (success_flag,ok_results)
 
   where
-    writeLogQueue :: LogQueue -> Maybe (Severity,SrcSpan,PprStyle,MsgDoc) -> IO ()
+    writeLogQueue :: LogQueue -> Maybe (WarnReason,Severity,SrcSpan,PprStyle,MsgDoc) -> IO ()
     writeLogQueue (LogQueue ref sem) msg = do
         atomicModifyIORef' ref $ \msgs -> (msg:msgs,())
         _ <- tryPutMVar sem ()
@@ -888,8 +888,8 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do
     -- The log_action callback that is used to synchronize messages from a
     -- worker thread.
     parLogAction :: LogQueue -> LogAction
-    parLogAction log_queue _dflags !severity !srcSpan !style !msg = do
-        writeLogQueue log_queue (Just (severity,srcSpan,style,msg))
+    parLogAction log_queue _dflags !reason !severity !srcSpan !style !msg = do
+        writeLogQueue log_queue (Just (reason,severity,srcSpan,style,msg))
 
     -- Print each message from the log_queue using the log_action from the
     -- session's DynFlags.
@@ -902,8 +902,8 @@ parUpsweep n_jobs old_hpt stable_mods cleanup sccs = do
 
             print_loop [] = read_msgs
             print_loop (x:xs) = case x of
-                Just (severity,srcSpan,style,msg) -> do
-                    log_action dflags dflags severity srcSpan style msg
+                Just (reason,severity,srcSpan,style,msg) -> do
+                    log_action dflags dflags reason severity srcSpan style msg
                     print_loop xs
                 -- Exit the loop once we encounter the end marker.
                 Nothing -> return ()