+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
+
+-------------------------
+
+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}
+
+\begin{code}
+addNameClashErrRn rdr_name (name1:names)
+ = addErrRn (vcat [ptext SLIT("Ambiguous occurrence") <+> quotes (ppr rdr_name),
+ ptext SLIT("It could refer to") <+> vcat (msg1 : msgs)])
+ where
+ msg1 = ptext SLIT("either") <+> mk_ref name1
+ msgs = [ptext SLIT(" or") <+> mk_ref name | name <- names]
+ mk_ref name = quotes (ppr name) <> comma <+> pprNameProvenance name
+
+fixityClashErr (rdr_name, ((_,how_in_scope1), (_, how_in_scope2)))
+ = hang (hsep [ptext SLIT("Conflicting fixities for"), quotes (ppr rdr_name)])
+ 4 (vcat [ppr how_in_scope1,
+ ppr how_in_scope2])
+
+shadowedNameWarn shadow
+ = hsep [ptext SLIT("This binding for"),
+ quotes (ppr shadow),
+ ptext SLIT("shadows an existing binding")]
+
+unknownNameErr name
+ = sep [text flavour, ptext SLIT("not in scope:"), quotes (ppr name)]