+
+\begin{code}
+warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
+
+warnUnusedImports names
+ | not opt_WarnUnusedImports
+ = returnRn () -- Don't force names unless necessary
+ | otherwise
+ = warnUnusedBinds (const True) names
+
+warnUnusedLocalBinds ns
+ | not opt_WarnUnusedBinds = returnRn ()
+ | otherwise = warnUnusedBinds (const True) ns
+
+warnUnusedMatches names
+ | opt_WarnUnusedMatches = warnUnusedGroup (const True) names
+ | otherwise = returnRn ()
+
+-------------------------
+
+warnUnusedBinds :: (Bool -> Bool) -> [Name] -> RnM d ()
+warnUnusedBinds warn_when_local names
+ = mapRn_ (warnUnusedGroup warn_when_local) groups
+ where
+ -- Group by provenance
+ groups = equivClasses cmp names
+ name1 `cmp` name2 = getNameProvenance name1 `cmp_prov` getNameProvenance name2
+
+ cmp_prov (LocalDef _ _) (NonLocalDef _ _) = LT
+ cmp_prov (LocalDef loc1 _) (LocalDef loc2 _) = loc1 `compare` loc2
+ cmp_prov (NonLocalDef (UserImport m1 loc1 _) _)
+ (NonLocalDef (UserImport m2 loc2 _) _) =
+ (m1 `compare` m2) `thenCmp` (loc1 `compare` loc2)
+ cmp_prov (NonLocalDef _ _) (LocalDef _ _) = GT
+ -- In-scope NonLocalDefs must have UserImport info on them
+
+-------------------------
+
+-- NOTE: the function passed to warnUnusedGroup is
+-- now always (const True) so we should be able to
+-- simplify the code slightly. I'm leaving it there
+-- for now just in case I havn't realised why it was there.
+-- Looks highly bogus to me. SLPJ Dec 99
+
+warnUnusedGroup :: (Bool -> Bool) -> [Name] -> RnM d ()
+warnUnusedGroup emit_warning names
+ | null filtered_names = returnRn ()
+ | not (emit_warning is_local) = returnRn ()
+ | otherwise
+ = pushSrcLocRn def_loc $
+ addWarnRn $
+ sep [msg <> colon, nest 4 (fsep (punctuate comma (map ppr filtered_names)))]
+ where
+ filtered_names = filter reportable names
+ name1 = head filtered_names
+ (is_local, def_loc, msg)
+ = case getNameProvenance name1 of
+ LocalDef loc _ -> (True, loc, text "Defined but not used")
+ NonLocalDef (UserImport mod loc _) _ ->
+ (True, loc, text "Imported from" <+> quotes (ppr mod) <+>
+ text "but not used")
+ other -> (False, getSrcLoc name1, text "Strangely defined but not used")
+
+ reportable name = case occNameUserString (nameOccName name) of
+ ('_' : _) -> False
+ zz_other -> True
+ -- Haskell 98 encourages compilers to suppress warnings about
+ -- unused names in a pattern if they start with "_".
+\end{code}
+