From 2dcebe69f07f9b4328bc3dc2131ccf2953ffa21b Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Mon, 20 Aug 2018 09:48:41 +0100 Subject: Fix unused-import warnings This patch fixes a fairly long-standing bug (dating back to 2015) in RdrName.bestImport, namely commit 9376249b6b78610db055a10d05f6592d6bbbea2f Author: Simon Peyton Jones Date: Wed Oct 28 17:16:55 2015 +0000 Fix unused-import stuff in a better way In that patch got the sense of the comparison back to front, and thereby failed to implement the unused-import rules described in Note [Choosing the best import declaration] in RdrName This led to Trac #13064 and #15393 Fixing this bug revealed a bunch of unused imports in libraries; the ones in the GHC repo are part of this commit. The two important changes are * Fix the bug in bestImport * Modified the rules by adding (a) in Note [Choosing the best import declaration] in RdrName Reason: the previosu rules made Trac #5211 go bad again. And the new rule (a) makes sense to me. In unravalling this I also ended up doing a few other things * Refactor RnNames.ImportDeclUsage to use a [GlobalRdrElt] for the things that are used, rather than [AvailInfo]. This is simpler and more direct. * Rename greParentName to greParent_maybe, to follow GHC naming conventions * Delete dead code RdrName.greUsedRdrName * Slightly change the spec of the unused function HsImpExpr.ieLWrappedName, and use it in RnNames.findImportUsage --- compiler/basicTypes/RdrName.hs | 102 ++++++--- compiler/cmm/CmmSink.hs | 1 - compiler/codeGen/StgCmmProf.hs | 1 - compiler/ghci/ByteCodeLink.hs | 1 - compiler/ghci/RtClosureInspect.hs | 1 - compiler/hsSyn/Convert.hs | 1 - compiler/hsSyn/HsBinds.hs | 1 - compiler/hsSyn/HsImpExp.hs | 4 +- compiler/llvmGen/LlvmCodeGen/CodeGen.hs | 1 - compiler/main/Ar.hs | 1 - compiler/main/DynFlags.hs | 2 + compiler/main/DynamicLoading.hs | 5 +- compiler/main/GHC.hs | 2 - compiler/main/HscMain.hs | 1 - compiler/main/Packages.hs | 1 - compiler/parser/RdrHsSyn.hs | 1 - compiler/rename/RnEnv.hs | 19 +- compiler/rename/RnExpr.hs-boot | 1 - compiler/rename/RnNames.hs | 231 +++++++++++---------- compiler/specialise/Specialise.hs | 1 - compiler/typecheck/ClsInst.hs | 2 - compiler/typecheck/TcDeriv.hs | 2 +- compiler/typecheck/TcErrors.hs | 2 +- compiler/typecheck/TcHsSyn.hs | 1 - compiler/typecheck/TcInstDcls.hs-boot | 1 - compiler/typecheck/TcInteract.hs | 2 +- compiler/typecheck/TcPatSyn.hs | 3 +- compiler/typecheck/TcRnTypes.hs | 3 +- compiler/typecheck/TcSMonad.hs | 1 - compiler/typecheck/TcTypeable.hs | 1 - compiler/types/TyCon.hs | 3 +- compiler/utils/OrdList.hs | 1 - compiler/utils/Outputable.hs | 1 - ghc/GHCi/Leak.hs | 2 +- libraries/base/Data/Functor/Classes.hs | 1 - libraries/base/Data/Functor/Compose.hs | 2 - libraries/base/Data/Functor/Contravariant.hs | 1 - libraries/base/Data/Functor/Product.hs | 3 - libraries/base/Data/Functor/Sum.hs | 2 - libraries/base/Data/Semigroup.hs | 3 - libraries/base/GHC/Event/PSQ.hs | 1 - libraries/base/GHC/Generics.hs | 2 +- libraries/base/GHC/Show.hs | 1 - libraries/base/GHC/StaticPtr.hs | 1 - libraries/ghc-prim/GHC/Magic.hs | 2 +- testsuite/tests/module/mod177.stderr | 2 +- .../ghci/duplicaterecfldsghci01.stdout | 18 +- testsuite/tests/rename/should_compile/T13064.hs | 8 + .../tests/rename/should_compile/T13064.stderr | 3 + testsuite/tests/rename/should_compile/T4239.stdout | 2 +- testsuite/tests/rename/should_compile/all.T | 1 + .../tests/rename/should_fail/rnfail044.stderr | 9 +- 52 files changed, 253 insertions(+), 212 deletions(-) create mode 100644 testsuite/tests/rename/should_compile/T13064.hs create mode 100644 testsuite/tests/rename/should_compile/T13064.stderr diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 610233ed9a..4a9d3e9841 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -53,14 +53,14 @@ module RdrName ( -- * GlobalRdrElts gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE, - greUsedRdrName, greRdrNames, greSrcSpan, greQualModName, + greRdrNames, greSrcSpan, greQualModName, gresToAvailInfo, -- ** Global 'RdrName' mapping elements: 'GlobalRdrElt', 'Provenance', 'ImportSpec' GlobalRdrElt(..), isLocalGRE, isRecFldGRE, greLabel, unQualOK, qualSpecOK, unQualSpecOK, pprNameProvenance, - Parent(..), + Parent(..), greParent_maybe, ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), importSpecLoc, importSpecModule, isExplicitItem, bestImport, @@ -657,18 +657,6 @@ greQualModName gre@(GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss }) | (is:_) <- iss = is_as (is_decl is) | otherwise = pprPanic "greQualModName" (ppr gre) -greUsedRdrName :: GlobalRdrElt -> RdrName --- For imported things, return a RdrName to add to the used-RdrName --- set, which is used to generate unused-import-decl warnings. --- Return a Qual RdrName if poss, so that identifies the most --- specific ImportSpec. See Trac #10890 for some good examples. -greUsedRdrName gre@GRE{ gre_name = name, gre_lcl = lcl, gre_imp = iss } - | lcl, Just mod <- nameModule_maybe name = Qual (moduleName mod) occ - | not (null iss), is <- bestImport iss = Qual (is_as (is_decl is)) occ - | otherwise = pprTrace "greUsedRdrName" (ppr gre) (Unqual occ) - where - occ = greOccName gre - greRdrNames :: GlobalRdrElt -> [RdrName] greRdrNames gre@GRE{ gre_lcl = lcl, gre_imp = iss } = (if lcl then [unqual] else []) ++ concatMap do_spec (map is_decl iss) @@ -696,11 +684,11 @@ mkParent _ (Avail _) = NoParent mkParent n (AvailTC m _ _) | n == m = NoParent | otherwise = ParentIs m -greParentName :: GlobalRdrElt -> Maybe Name -greParentName gre = case gre_par gre of - NoParent -> Nothing - ParentIs n -> Just n - FldParent n _ -> Just n +greParent_maybe :: GlobalRdrElt -> Maybe Name +greParent_maybe gre = case gre_par gre of + NoParent -> Nothing + ParentIs n -> Just n + FldParent n _ -> Just n -- | Takes a list of distinct GREs and folds them -- into AvailInfos. This is more efficient than mapping each individual @@ -716,7 +704,7 @@ gresToAvailInfo gres add :: NameEnv AvailInfo -> GlobalRdrElt -> NameEnv AvailInfo add env gre = extendNameEnv_Acc comb availFromGRE env (fromMaybe (gre_name gre) - (greParentName gre)) gre + (greParent_maybe gre)) gre where -- We want to insert the child `k` into a list of children but @@ -1192,10 +1180,7 @@ instance Ord ImpItemSpec where bestImport :: [ImportSpec] -> ImportSpec --- Given a non-empty bunch of ImportSpecs, return the one that --- imported the item most specifically (e.g. by name), using --- textually-first as a tie breaker. This is used when reporting --- redundant imports +-- See Note [Choosing the best import declaration] bestImport iss = case sortBy best iss of (is:_) -> is @@ -1203,17 +1188,76 @@ bestImport iss where best :: ImportSpec -> ImportSpec -> Ordering -- Less means better + -- Unqualified always wins over qualified; then + -- import-all wins over import-some; then + -- earlier declaration wins over later best (ImpSpec { is_item = item1, is_decl = d1 }) (ImpSpec { is_item = item2, is_decl = d2 }) - = best_item item1 item2 `thenCmp` (is_dloc d1 `compare` is_dloc d2) + = (is_qual d1 `compare` is_qual d2) `thenCmp` + (best_item item1 item2) `thenCmp` + (is_dloc d1 `compare` is_dloc d2) best_item :: ImpItemSpec -> ImpItemSpec -> Ordering best_item ImpAll ImpAll = EQ - best_item ImpAll (ImpSome {}) = GT - best_item (ImpSome {}) ImpAll = LT + best_item ImpAll (ImpSome {}) = LT + best_item (ImpSome {}) ImpAll = GT best_item (ImpSome { is_explicit = e1 }) - (ImpSome { is_explicit = e2 }) = e2 `compare` e1 - -- False < True, so if e1 is explicit and e2 is not, we get LT + (ImpSome { is_explicit = e2 }) = e1 `compare` e2 + -- False < True, so if e1 is explicit and e2 is not, we get GT + +{- Note [Choosing the best import declaration] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +When reporting unused import declarations we use the following rules. + (see [wiki:Commentary/Compiler/UnusedImports]) + +Say that an import-item is either + * an entire import-all decl (eg import Foo), or + * a particular item in an import list (eg import Foo( ..., x, ...)). +The general idea is that for each /occurrence/ of an imported name, we will +attribute that use to one import-item. Once we have processed all the +occurrences, any import items with no uses attributed to them are unused, and are +warned about. More precisely: + +1. For every RdrName in the program text, find its GlobalRdrElt. + +2. Then, from the [ImportSpec] (gre_imp) of that GRE, choose one + the "chosen import-item", and mark it "used". This is done + by 'bestImport' + +3. After processing all the RdrNames, bleat about any + import-items that are unused. + This is done in RnNames.warnUnusedImportDecls. + +The function 'bestImport' returns the dominant import among the +ImportSpecs it is given, implementing Step 2. We say import-item A +dominates import-item B if we choose A over B. In general, we try to +choose the import that is most likely to render other imports +unnecessary. Here is the dominance relationship we choose: + + a) import Foo dominates import qualified Foo. + + b) import Foo dominates import Foo(x). + + c) Otherwise choose the textually first one. + +Rationale for (a). Consider + import qualified M -- Import #1 + import M( x ) -- Import #2 + foo = M.x + x + +The unqualified 'x' can only come from import #2. The qualified 'M.x' +could come from either, but bestImport picks import #2, because it is +more likely to be useful in other imports, as indeed it is in this +case (see Trac #5211 for a concrete example). + +But the rules are not perfect; consider + import qualified M -- Import #1 + import M( x ) -- Import #2 + foo = M.x + M.y + +The M.x will use import #2, but M.y can only use import #1. +-} + unQualSpecOK :: ImportSpec -> Bool -- ^ Is in scope unqualified? diff --git a/compiler/cmm/CmmSink.hs b/compiler/cmm/CmmSink.hs index 43444639e1..c9d0e2857a 100644 --- a/compiler/cmm/CmmSink.hs +++ b/compiler/cmm/CmmSink.hs @@ -22,7 +22,6 @@ import UniqFM import PprCmm () import qualified Data.IntSet as IntSet -import Data.List (partition) import qualified Data.Set as Set import Data.List import Data.Maybe diff --git a/compiler/codeGen/StgCmmProf.hs b/compiler/codeGen/StgCmmProf.hs index 15c31ca59c..172b77c8f9 100644 --- a/compiler/codeGen/StgCmmProf.hs +++ b/compiler/codeGen/StgCmmProf.hs @@ -35,7 +35,6 @@ import Cmm import CmmUtils import CLabel -import qualified Module import CostCentre import DynFlags import FastString diff --git a/compiler/ghci/ByteCodeLink.hs b/compiler/ghci/ByteCodeLink.hs index e7eb7108f9..9a5fb39e6d 100644 --- a/compiler/ghci/ByteCodeLink.hs +++ b/compiler/ghci/ByteCodeLink.hs @@ -41,7 +41,6 @@ import Util -- Standard libraries import Data.Array.Unboxed import Foreign.Ptr -import GHC.IO ( IO(..) ) import GHC.Exts {- diff --git a/compiler/ghci/RtClosureInspect.hs b/compiler/ghci/RtClosureInspect.hs index 95c2e37136..982b8f660a 100644 --- a/compiler/ghci/RtClosureInspect.hs +++ b/compiler/ghci/RtClosureInspect.hs @@ -59,7 +59,6 @@ import Outputable as Ppr import GHC.Char import GHC.Exts import GHC.Exts.Heap -import GHC.IO ( IO(..) ) import SMRep ( roundUpTo ) import Control.Monad diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs index fbecf9ce9e..0dc2d9aef4 100644 --- a/compiler/hsSyn/Convert.hs +++ b/compiler/hsSyn/Convert.hs @@ -23,7 +23,6 @@ import RdrName import qualified Name import Module import RdrHsSyn -import qualified OccName import OccName import SrcLoc import Type diff --git a/compiler/hsSyn/HsBinds.hs b/compiler/hsSyn/HsBinds.hs index 98f503b0d9..c541a129ce 100644 --- a/compiler/hsSyn/HsBinds.hs +++ b/compiler/hsSyn/HsBinds.hs @@ -44,7 +44,6 @@ import DynFlags import Data.Data hiding ( Fixity ) import Data.List hiding ( foldr ) import Data.Ord -import Data.Foldable ( Foldable(..) ) {- ************************************************************************ diff --git a/compiler/hsSyn/HsImpExp.hs b/compiler/hsSyn/HsImpExp.hs index 39bd9b7e18..a48fdb2f3e 100644 --- a/compiler/hsSyn/HsImpExp.hs +++ b/compiler/hsSyn/HsImpExp.hs @@ -281,8 +281,8 @@ ieWrappedName (IEName (L _ n)) = n ieWrappedName (IEPattern (L _ n)) = n ieWrappedName (IEType (L _ n)) = n -ieLWrappedName :: LIEWrappedName name -> Located name -ieLWrappedName (L l n) = L l (ieWrappedName n) +ieLWrappedName :: LIEWrappedName name -> name +ieLWrappedName (L l n) = ieWrappedName n replaceWrappedName :: IEWrappedName name1 -> name2 -> IEWrappedName name2 replaceWrappedName (IEName (L l _)) n = IEName (L l n) diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs index 51de1f6850..7c6de7fe43 100644 --- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs +++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs @@ -38,7 +38,6 @@ import Util import Control.Monad.Trans.Class import Control.Monad.Trans.Writer -import Data.Semigroup ( Semigroup ) import qualified Data.Semigroup as Semigroup import Data.List ( nub ) import Data.Maybe ( catMaybes ) diff --git a/compiler/main/Ar.hs b/compiler/main/Ar.hs index 9ead0535ad..8b23402f23 100644 --- a/compiler/main/Ar.hs +++ b/compiler/main/Ar.hs @@ -34,7 +34,6 @@ module Ar import GhcPrelude -import Data.Semigroup (Semigroup) import Data.List (mapAccumL, isPrefixOf) import Data.Monoid ((<>)) import Data.Binary.Get diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 66c67c352e..0bb796bb82 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -244,7 +244,9 @@ import qualified EnumSet import GHC.Foreign (withCString, peekCString) import qualified GHC.LanguageExtensions as LangExt +#if defined(GHCI) import Foreign (Ptr) -- needed for 2nd stage +#endif -- Note [Updating flag description in the User's Guide] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/compiler/main/DynamicLoading.hs b/compiler/main/DynamicLoading.hs index 764bf2dd41..7420f7cc01 100644 --- a/compiler/main/DynamicLoading.hs +++ b/compiler/main/DynamicLoading.hs @@ -25,7 +25,6 @@ module DynamicLoading ( ) where import GhcPrelude -import HscTypes ( HscEnv ) import DynFlags #if defined(GHCI) @@ -63,6 +62,7 @@ import GHC.Exts ( unsafeCoerce# ) #else +import HscTypes ( HscEnv ) import Module ( ModuleName, moduleNameString ) import Panic @@ -76,12 +76,13 @@ import Control.Monad ( unless ) -- actual compilation starts. Idempotent operation. Should be re-called if -- pluginModNames or pluginModNameOpts changes. initializePlugins :: HscEnv -> DynFlags -> IO DynFlags -initializePlugins hsc_env df #if !defined(GHCI) +initializePlugins _ df = do let pluginMods = pluginModNames df unless (null pluginMods) (pluginError pluginMods) return df #else +initializePlugins hsc_env df | map lpModuleName (plugins df) == pluginModNames df -- plugins not changed && all (\p -> lpArguments p == argumentsForPlugin p (pluginModNameOpts df)) (plugins df) -- arguments not changed diff --git a/compiler/main/GHC.hs b/compiler/main/GHC.hs index 0e20e21fdb..825335b30a 100644 --- a/compiler/main/GHC.hs +++ b/compiler/main/GHC.hs @@ -291,7 +291,6 @@ import GhcPrelude hiding (init) import ByteCodeTypes import InteractiveEval import InteractiveEvalTypes -import TcRnDriver ( runTcInteractive ) import GHCi import GHCi.RemoteTypes @@ -358,7 +357,6 @@ import Data.Set (Set) import qualified Data.Sequence as Seq import System.Directory ( doesFileExist ) import Data.Maybe -import Data.List ( find ) import Data.Time import Data.Typeable ( Typeable ) import Data.Word ( Word8 ) diff --git a/compiler/main/HscMain.hs b/compiler/main/HscMain.hs index a8a33bfaad..39d2f3dc6c 100644 --- a/compiler/main/HscMain.hs +++ b/compiler/main/HscMain.hs @@ -85,7 +85,6 @@ module HscMain import GhcPrelude import Data.Data hiding (Fixity, TyCon) -import DynFlags (addPluginModuleName) import Id import GHCi ( addSptEntry ) import GHCi.RemoteTypes ( ForeignHValue ) diff --git a/compiler/main/Packages.hs b/compiler/main/Packages.hs index 71354b1463..dfe8e237ff 100644 --- a/compiler/main/Packages.hs +++ b/compiler/main/Packages.hs @@ -95,7 +95,6 @@ import Data.List as List import Data.Map (Map) import Data.Set (Set) import Data.Monoid (First(..)) -import Data.Semigroup ( Semigroup ) import qualified Data.Semigroup as Semigroup import qualified Data.Map as Map import qualified Data.Map.Strict as MapStrict diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index 681ecdeae0..57e8c062bb 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -104,7 +104,6 @@ import FastString import Maybes import Util import ApiAnnotation -import HsExtension ( noExt ) import Data.List import qualified GHC.LanguageExtensions as LangExt import DynFlags ( WarningFlag(..) ) diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 16897c2681..76634b7c0d 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -77,7 +77,6 @@ import ListSetOps ( minusList ) import qualified GHC.LanguageExtensions as LangExt import RnUnbound import RnUtils -import Data.Maybe (isJust) import qualified Data.Semigroup as Semi import Data.Either ( partitionEithers ) import Data.List (find) @@ -638,21 +637,21 @@ lookupSubBndrOcc_helper must_have_parent warn_if_deprec parent rdr_name NoParent -> Nothing picked_gres :: [GlobalRdrElt] -> DisambigInfo + -- For Unqual, find GREs that are in scope qualified or unqualified + -- For Qual, find GREs that are in scope with that qualification picked_gres gres | isUnqual rdr_name - = mconcat (map right_parent gres) + = mconcat (map right_parent gres) | otherwise - = mconcat (map right_parent (pickGREs rdr_name gres)) - + = mconcat (map right_parent (pickGREs rdr_name gres)) right_parent :: GlobalRdrElt -> DisambigInfo right_parent p - | Just cur_parent <- getParent p - = if parent == cur_parent - then DisambiguatedOccurrence p - else NoOccurrence - | otherwise - = UniqueOccurrence p + = case getParent p of + Just cur_parent + | parent == cur_parent -> DisambiguatedOccurrence p + | otherwise -> NoOccurrence + Nothing -> UniqueOccurrence p -- This domain specific datatype is used to record why we decided it was diff --git a/compiler/rename/RnExpr.hs-boot b/compiler/rename/RnExpr.hs-boot index a944d7124e..b325eeb6f0 100644 --- a/compiler/rename/RnExpr.hs-boot +++ b/compiler/rename/RnExpr.hs-boot @@ -5,7 +5,6 @@ import NameSet ( FreeVars ) import TcRnTypes import SrcLoc ( Located ) import Outputable ( Outputable ) -import HsExtension ( GhcPs, GhcRn ) rnLExpr :: LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index cf4c258d01..bfa7ee0e94 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -63,13 +63,11 @@ import qualified GHC.LanguageExtensions as LangExt import Control.Monad import Data.Either ( partitionEithers, isRight, rights ) --- import qualified Data.Foldable as Foldable import Data.Map ( Map ) import qualified Data.Map as Map import Data.Ord ( comparing ) import Data.List ( partition, (\\), find, sortBy ) import qualified Data.Set as S --- import qualified Data.Set as Set import System.FilePath (()) import System.IO @@ -1094,8 +1092,8 @@ gresFromIE decl_spec (L loc ie, avail) = gresFromAvail prov_fn avail where is_explicit = case ie of - IEThingAll _ (L _ name) -> \n -> n == ieWrappedName name - _ -> \_ -> True + IEThingAll _ name -> \n -> n == ieLWrappedName name + _ -> \_ -> True prov_fn name = Just (ImpSpec { is_decl = decl_spec, is_item = item_spec }) where @@ -1217,44 +1215,11 @@ reportUnusedNames _export_decls gbl_env is_unused_local :: GlobalRdrElt -> Bool is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre) -{- -********************************************************* -* * -\subsection{Unused imports} -* * -********************************************************* - -This code finds which import declarations are unused. The -specification and implementation notes are here: - http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/UnusedImports --} - -type ImportDeclUsage - = ( LImportDecl GhcRn -- The import declaration - , [AvailInfo] -- What *is* used (normalised) - , [Name] ) -- What is imported but *not* used - -warnUnusedImportDecls :: TcGblEnv -> RnM () -warnUnusedImportDecls gbl_env - = do { uses <- readMutVar (tcg_used_gres gbl_env) - ; let user_imports = filterOut (ideclImplicit . unLoc) (tcg_rn_imports gbl_env) - -- This whole function deals only with *user* imports - -- both for warning about unnecessary ones, and for - -- deciding the minimal ones - rdr_env = tcg_rdr_env gbl_env - fld_env = mkFieldEnv rdr_env - - ; let usage :: [ImportDeclUsage] - usage = findImportUsage user_imports uses - - ; traceRn "warnUnusedImportDecls" $ - (vcat [ text "Uses:" <+> ppr uses - , text "Import usage" <+> ppr usage]) - ; whenWOptM Opt_WarnUnusedImports $ - mapM_ (warnUnusedImport Opt_WarnUnusedImports fld_env) usage - - ; whenGOptM Opt_D_dump_minimal_imports $ - printMinimalImports usage } +{- ********************************************************************* +* * + Missing signatures +* * +********************************************************************* -} -- | Warn the user about top level binders that lack type signatures. -- Called /after/ type inference, so that we can report the @@ -1312,29 +1277,48 @@ warnMissingSignatures gbl_env ; add_sig_warns } + {- -Note [The ImportMap] -~~~~~~~~~~~~~~~~~~~~ -The ImportMap is a short-lived intermediate data structure records, for -each import declaration, what stuff brought into scope by that -declaration is actually used in the module. +********************************************************* +* * +\subsection{Unused imports} +* * +********************************************************* -The SrcLoc is the location of the END of a particular 'import' -declaration. Why *END*? Because we don't want to get confused -by the implicit Prelude import. Consider (Trac #7476) the module - import Foo( foo ) - main = print foo -There is an implicit 'import Prelude(print)', and it gets a SrcSpan -of line 1:1 (just the point, not a span). If we use the *START* of -the SrcSpan to identify the import decl, we'll confuse the implicit -import Prelude with the explicit 'import Foo'. So we use the END. -It's just a cheap hack; we could equally well use the Span too. +This code finds which import declarations are unused. The +specification and implementation notes are here: + http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/UnusedImports -The AvailInfos are the things imported from that decl (just a list, -not normalised). +See also Note [Choosing the best import declaration] in RdrName -} -type ImportMap = Map SrcLoc [AvailInfo] -- See [The ImportMap] +type ImportDeclUsage + = ( LImportDecl GhcRn -- The import declaration + , [GlobalRdrElt] -- What *is* used (normalised) + , [Name] ) -- What is imported but *not* used + +warnUnusedImportDecls :: TcGblEnv -> RnM () +warnUnusedImportDecls gbl_env + = do { uses <- readMutVar (tcg_used_gres gbl_env) + ; let user_imports = filterOut (ideclImplicit . unLoc) (tcg_rn_imports gbl_env) + -- This whole function deals only with *user* imports + -- both for warning about unnecessary ones, and for + -- deciding the minimal ones + rdr_env = tcg_rdr_env gbl_env + fld_env = mkFieldEnv rdr_env + + ; let usage :: [ImportDeclUsage] + usage = findImportUsage user_imports uses + + ; traceRn "warnUnusedImportDecls" $ + (vcat [ text "Uses:" <+> ppr uses + , text "Import usage" <+> ppr usage]) + + ; whenWOptM Opt_WarnUnusedImports $ + mapM_ (warnUnusedImport Opt_WarnUnusedImports fld_env) usage + + ; whenGOptM Opt_D_dump_minimal_imports $ + printMinimalImports usage } findImportUsage :: [LImportDecl GhcRn] -> [GlobalRdrElt] @@ -1344,16 +1328,17 @@ findImportUsage imports used_gres = map unused_decl imports where import_usage :: ImportMap - import_usage - = foldr extendImportMap Map.empty used_gres + import_usage = mkImportMap used_gres unused_decl decl@(L loc (ImportDecl { ideclHiding = imps })) - = (decl, nubAvails used_avails, nameSetElemsStable unused_imps) + = (decl, used_gres, nameSetElemsStable unused_imps) where - used_avails = Map.lookup (srcSpanEnd loc) import_usage `orElse` [] - -- srcSpanEnd: see Note [The ImportMap] - used_names = availsToNameSetWithSelectors used_avails - used_parents = mkNameSet [n | AvailTC n _ _ <- used_avails] + used_gres = Map.lookup (srcSpanEnd loc) import_usage + -- srcSpanEnd: see Note [The ImportMap] + `orElse` [] + + used_names = mkNameSet (map gre_name used_gres) + used_parents = mkNameSet (mapMaybe greParent_maybe used_gres) unused_imps -- Not trivial; see eg Trac #7454 = case imps of @@ -1362,19 +1347,16 @@ findImportUsage imports used_gres _other -> emptyNameSet -- No explicit import list => no unused-name list add_unused :: IE GhcRn -> NameSet -> NameSet - add_unused (IEVar _ (L _ n)) acc - = add_unused_name (ieWrappedName n) acc - add_unused (IEThingAbs _ (L _ n)) acc - = add_unused_name (ieWrappedName n) acc - add_unused (IEThingAll _ (L _ n)) acc - = add_unused_all (ieWrappedName n) acc - add_unused (IEThingWith _ (L _ p) wc ns fs) acc = - add_wc_all (add_unused_with (ieWrappedName p) xs acc) - where xs = map (ieWrappedName . unLoc) ns - ++ map (flSelector . unLoc) fs + add_unused (IEVar _ n) acc = add_unused_name (ieLWrappedName n) acc + add_unused (IEThingAbs _ n) acc = add_unused_name (ieLWrappedName n) acc + add_unused (IEThingAll _ n) acc = add_unused_all (ieLWrappedName n) acc + add_unused (IEThingWith _ p wc ns fs) acc = + add_wc_all (add_unused_with pn xs acc) + where pn = ieLWrappedName p + xs = map ieLWrappedName ns ++ map (flSelector . unLoc) fs add_wc_all = case wc of NoIEWildcard -> id - IEWildcard _ -> add_unused_all (ieWrappedName p) + IEWildcard _ -> add_unused_all pn add_unused _ acc = acc add_unused_name n acc @@ -1394,49 +1376,86 @@ findImportUsage imports used_gres -- Num is not itself mentioned. Hence the two cases in add_unused_with. unused_decl (L _ (XImportDecl _)) = panic "unused_decl" -extendImportMap :: GlobalRdrElt -> ImportMap -> ImportMap + +{- Note [The ImportMap] +~~~~~~~~~~~~~~~~~~~~~~~ +The ImportMap is a short-lived intermediate data structure records, for +each import declaration, what stuff brought into scope by that +declaration is actually used in the module. + +The SrcLoc is the location of the END of a particular 'import' +declaration. Why *END*? Because we don't want to get confused +by the implicit Prelude import. Consider (Trac #7476) the module + import Foo( foo ) + main = print foo +There is an implicit 'import Prelude(print)', and it gets a SrcSpan +of line 1:1 (just the point, not a span). If we use the *START* of +the SrcSpan to identify the import decl, we'll confuse the implicit +import Prelude with the explicit 'import Foo'. So we use the END. +It's just a cheap hack; we could equally well use the Span too. + +The [GlobalRdrElt] are the things imported from that decl. +-} + +type ImportMap = Map SrcLoc [GlobalRdrElt] -- See [The ImportMap] + -- If loc :-> gres, then + -- 'loc' = the end loc of the bestImport of each GRE in 'gres' + +mkImportMap :: [GlobalRdrElt] -> ImportMap -- For each of a list of used GREs, find all the import decls that brought -- it into scope; choose one of them (bestImport), and record -- the RdrName in that import decl's entry in the ImportMap -extendImportMap gre imp_map - = add_imp gre (bestImport (gre_imp gre)) imp_map +mkImportMap gres + = foldr add_one Map.empty gres where - add_imp :: GlobalRdrElt -> ImportSpec -> ImportMap -> ImportMap - add_imp gre (ImpSpec { is_decl = imp_decl_spec }) imp_map - = Map.insertWith add decl_loc [avail] imp_map - where - add _ avails = avail : avails -- add is really just a specialised (++) - decl_loc = srcSpanEnd (is_dloc imp_decl_spec) - -- For srcSpanEnd see Note [The ImportMap] - avail = availFromGRE gre + add_one gre@(GRE { gre_imp = imp_specs }) imp_map + = Map.insertWith add decl_loc [gre] imp_map + where + best_imp_spec = bestImport imp_specs + decl_loc = srcSpanEnd (is_dloc (is_decl best_imp_spec)) + -- For srcSpanEnd see Note [The ImportMap] + add _ gres = gre : gres warnUnusedImport :: WarningFlag -> NameEnv (FieldLabelString, Name) -> ImportDeclUsage -> RnM () warnUnusedImport flag fld_env (L loc decl, used, unused) + + -- Do not warn for 'import M()' | Just (False,L _ []) <- ideclHiding decl - = return () -- Do not warn for 'import M()' + = return () + -- Note [Do not warn about Prelude hiding] | Just (True, L _ hides) <- ideclHiding decl , not (null hides) , pRELUDE_NAME == unLoc (ideclName decl) - = return () -- Note [Do not warn about Prelude hiding] - | null used = addWarnAt (Reason flag) loc msg1 -- Nothing used; drop entire decl - | null unused = return () -- Everything imported is used; nop - | otherwise = addWarnAt (Reason flag) loc msg2 -- Some imports are unused + = return () + + -- Nothing used; drop entire declaration + | null used + = addWarnAt (Reason flag) loc msg1 + + -- Everything imported is used; nop + | null unused + = return () + + -- Some imports are unused + | otherwise + = addWarnAt (Reason flag) loc msg2 + where - msg1 = vcat [pp_herald <+> quotes pp_mod <+> pp_not_used, - nest 2 (text "except perhaps to import instances from" - <+> quotes pp_mod), - text "To import instances alone, use:" + msg1 = vcat [ pp_herald <+> quotes pp_mod <+> is_redundant + , nest 2 (text "except perhaps to import instances from" + <+> quotes pp_mod) + , text "To import instances alone, use:" <+> text "import" <+> pp_mod <> parens Outputable.empty ] - msg2 = sep [pp_herald <+> quotes sort_unused, - text "from module" <+> quotes pp_mod <+> pp_not_used] + msg2 = sep [ pp_herald <+> quotes sort_unused + , text "from module" <+> quotes pp_mod <+> is_redundant] pp_herald = text "The" <+> pp_qual <+> text "import of" pp_qual | ideclQualified decl = text "qualified" | otherwise = Outputable.empty - pp_mod = ppr (unLoc (ideclName decl)) - pp_not_used = text "is redundant" + pp_mod = ppr (unLoc (ideclName decl)) + is_redundant = text "is redundant" -- In warning message, pretty-print identifiers unqualified unconditionally -- to improve the consistent for ambiguous/unambiguous identifiers. @@ -1446,8 +1465,9 @@ warnUnusedImport flag fld_env (L loc decl, used, unused) Nothing -> pprNameUnqualified n -- Print unused names in a deterministic (lexicographic) order + sort_unused :: SDoc sort_unused = pprWithCommas ppr_possible_field $ - sortBy (comparing nameOccName) unused + sortBy (comparing nameOccName) unused {- Note [Do not warn about Prelude hiding] @@ -1475,7 +1495,7 @@ decls, and simply trim their import lists. NB that getMinimalImports :: [ImportDeclUsage] -> RnM [LImportDecl GhcRn] getMinimalImports = mapM mk_minimal where - mk_minimal (L l decl, used, unused) + mk_minimal (L l decl, used_gres, unused) | null unused , Just (False, _) <- ideclHiding decl = return (L l decl) @@ -1484,7 +1504,8 @@ getMinimalImports = mapM mk_minimal , ideclSource = is_boot , ideclPkgQual = mb_pkg } = decl ; iface <- loadSrcInterface doc mod_name is_boot (fmap sl_fs mb_pkg) - ; let lies = map (L l) (concatMap (to_ie iface) used) + ; let used_avails = gresToAvailInfo used_gres + lies = map (L l) (concatMap (to_ie iface) used_avails) ; return (L l (decl { ideclHiding = Just (False, L l lies) })) } where doc = text "Compute minimal imports for" <+> ppr decl diff --git a/compiler/specialise/Specialise.hs b/compiler/specialise/Specialise.hs index 13a7cb7474..0fdcc1b3ea 100644 --- a/compiler/specialise/Specialise.hs +++ b/compiler/specialise/Specialise.hs @@ -27,7 +27,6 @@ import Rules import CoreOpt ( collectBindersPushingCo ) import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkCast ) import CoreFVs -import FV ( InterestingVarFun ) import CoreArity ( etaExpandToJoinPointRule ) import UniqSupply import Name diff --git a/compiler/typecheck/ClsInst.hs b/compiler/typecheck/ClsInst.hs index de957b71fd..c0a54e48cc 100644 --- a/compiler/typecheck/ClsInst.hs +++ b/compiler/typecheck/ClsInst.hs @@ -29,9 +29,7 @@ import Id import Type import MkCore ( mkStringExprFS, mkNaturalExpr ) -import Unique ( hasKey ) import Name ( Name ) -import Var ( DFunId ) import DataCon import TyCon import Class diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 6f749fc60f..409cccbc72 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -26,7 +26,7 @@ import TcValidity( allDistinctTyVars ) import TcClassDcl( instDeclCtxt3, tcATDefault, tcMkDeclCtxt ) import TcEnv import TcGenDeriv -- Deriv stuff -import TcValidity +import TcValidity( checkValidInstHead ) import InstEnv import Inst import FamInstEnv diff --git a/compiler/typecheck/TcErrors.hs b/compiler/typecheck/TcErrors.hs index bc5b061a9e..ce75259203 100644 --- a/compiler/typecheck/TcErrors.hs +++ b/compiler/typecheck/TcErrors.hs @@ -64,7 +64,7 @@ import qualified Data.Set as Set import {-# SOURCE #-} TcHoleErrors ( findValidHoleFits ) -import Data.Semigroup ( Semigroup ) +-- import Data.Semigroup ( Semigroup ) import qualified Data.Semigroup as Semigroup diff --git a/compiler/typecheck/TcHsSyn.hs b/compiler/typecheck/TcHsSyn.hs index 77e2a246cb..ee00acaad3 100644 --- a/compiler/typecheck/TcHsSyn.hs +++ b/compiler/typecheck/TcHsSyn.hs @@ -56,7 +56,6 @@ import TcEvidence import TysPrim import TyCon import TysWiredIn -import TyCoRep( CoercionHole(..) ) import Type import Coercion import ConLike diff --git a/compiler/typecheck/TcInstDcls.hs-boot b/compiler/typecheck/TcInstDcls.hs-boot index e7240903e4..ea0f50fd36 100644 --- a/compiler/typecheck/TcInstDcls.hs-boot +++ b/compiler/typecheck/TcInstDcls.hs-boot @@ -9,7 +9,6 @@ import HsSyn import TcRnTypes import TcEnv( InstInfo ) import TcDeriv -import HsExtension ( GhcRn ) -- We need this because of the mutual recursion -- between TcTyClsDecls and TcInstDcls diff --git a/compiler/typecheck/TcInteract.hs b/compiler/typecheck/TcInteract.hs index 028b755187..cb1747cdb0 100644 --- a/compiler/typecheck/TcInteract.hs +++ b/compiler/typecheck/TcInteract.hs @@ -27,7 +27,7 @@ import Class import TyCon import FunDeps import FamInst -import ClsInst( ClsInstResult(..), InstanceWhat(..), safeOverlap ) +import ClsInst( InstanceWhat(..), safeOverlap ) import FamInstEnv import Unify ( tcUnifyTyWithTFs, ruleMatchTyKiX ) diff --git a/compiler/typecheck/TcPatSyn.hs b/compiler/typecheck/TcPatSyn.hs index fabe16a1e0..c9dbc0f02f 100644 --- a/compiler/typecheck/TcPatSyn.hs +++ b/compiler/typecheck/TcPatSyn.hs @@ -17,10 +17,9 @@ import GhcPrelude import HsSyn import TcPat -import Type( mkEmptyTCvSubst, tidyTyVarBinders, tidyTypes, tidyType ) +import Type( tidyTyVarBinders, tidyTypes, tidyType ) import TcRnMonad import TcSigs( emptyPragEnv, completeSigFromId ) -import TcType( mkMinimalBySCs ) import TcEnv import TcMType import TcHsSyn( zonkTyVarBindersX, zonkTcTypeToTypes diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index ca5639b297..b240585f65 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -155,7 +155,7 @@ import TcEvidence import Type import Class ( Class ) import TyCon ( TyCon, TyConFlavour, tyConKind ) -import TyCoRep ( CoercionHole(..), coHoleCoVar ) +import TyCoRep ( coHoleCoVar ) import Coercion ( Coercion, mkHoleCo ) import ConLike ( ConLike(..) ) import DataCon ( DataCon, dataConUserType, dataConOrigArgTys ) @@ -556,6 +556,7 @@ data TcGblEnv tcg_dus :: DefUses, -- ^ What is defined in this module and what is used. tcg_used_gres :: TcRef [GlobalRdrElt], -- ^ Records occurrences of imported entities + -- One entry for each occurrence; but may have different GREs for the same Name -- See Note [Tracking unused binding and imports] tcg_keep :: TcRef NameSet, diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 5bf5cefe01..ad7d332781 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -143,7 +143,6 @@ import Kind import TcType import DynFlags import Type -import TyCoRep( coHoleCoVar ) import Coercion import Unify diff --git a/compiler/typecheck/TcTypeable.hs b/compiler/typecheck/TcTypeable.hs index ad266f658f..146c8515b6 100644 --- a/compiler/typecheck/TcTypeable.hs +++ b/compiler/typecheck/TcTypeable.hs @@ -31,7 +31,6 @@ import Type import Kind ( isTYPEApp ) import TyCon import DataCon -import Name ( getOccName ) import Module import HsSyn import DynFlags diff --git a/compiler/types/TyCon.hs b/compiler/types/TyCon.hs index 0a02adf0b6..a065c0d448 100644 --- a/compiler/types/TyCon.hs +++ b/compiler/types/TyCon.hs @@ -135,7 +135,7 @@ import {-# SOURCE #-} TysWiredIn ( runtimeRepTyCon, constraintKind , vecCountTyCon, vecElemTyCon, liftedTypeKind , mkFunKind, mkForAllKind ) import {-# SOURCE #-} DataCon ( DataCon, dataConExTyVars, dataConFieldLabels - , dataConTyCon, dataConFullSig ) + , dataConTyCon, dataConFullSig, isUnboxedSumCon ) import Binary import Var @@ -156,7 +156,6 @@ import Util import Unique( tyConRepNameUnique, dataConTyRepNameUnique ) import UniqSet import Module -import {-# SOURCE #-} DataCon import qualified Data.Data as Data diff --git a/compiler/utils/OrdList.hs b/compiler/utils/OrdList.hs index a5739764d4..e4a34ac693 100644 --- a/compiler/utils/OrdList.hs +++ b/compiler/utils/OrdList.hs @@ -19,7 +19,6 @@ import GhcPrelude import Outputable -import Data.Semigroup ( Semigroup ) import qualified Data.Semigroup as Semigroup infixl 5 `appOL` diff --git a/compiler/utils/Outputable.hs b/compiler/utils/Outputable.hs index 929c7f3d58..f8f1283b4d 100644 --- a/compiler/utils/Outputable.hs +++ b/compiler/utils/Outputable.hs @@ -108,7 +108,6 @@ import Panic import GHC.Serialized import GHC.LanguageExtensions (Extension) -import Control.Exception (finally) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.Char diff --git a/ghc/GHCi/Leak.hs b/ghc/GHCi/Leak.hs index 47fed9c28f..8135c3731e 100644 --- a/ghc/GHCi/Leak.hs +++ b/ghc/GHCi/Leak.hs @@ -7,7 +7,7 @@ module GHCi.Leak import Control.Monad import Data.Bits -import DynFlags (settings, sTargetPlatform) +import DynFlags ( sTargetPlatform ) import Foreign.Ptr (ptrToIntPtr, intPtrToPtr) import GHC import GHC.Exts (anyToAddr#) diff --git a/libraries/base/Data/Functor/Classes.hs b/libraries/base/Data/Functor/Classes.hs index e44c817b64..7c9b917608 100644 --- a/libraries/base/Data/Functor/Classes.hs +++ b/libraries/base/Data/Functor/Classes.hs @@ -69,7 +69,6 @@ import Control.Applicative (Alternative((<|>)), Const(Const)) import Data.Functor.Identity (Identity(Identity)) import Data.Proxy (Proxy(Proxy)) import Data.List.NonEmpty (NonEmpty(..)) -import Data.Monoid (mappend) import Data.Ord (Down(Down)) import GHC.Read (expectP, list, paren) diff --git a/libraries/base/Data/Functor/Compose.hs b/libraries/base/Data/Functor/Compose.hs index 8ceadb8572..4ddd12cb2f 100644 --- a/libraries/base/Data/Functor/Compose.hs +++ b/libraries/base/Data/Functor/Compose.hs @@ -27,8 +27,6 @@ import Data.Functor.Classes import Control.Applicative import Data.Coerce (coerce) import Data.Data (Data) -import Data.Foldable (Foldable(foldMap)) -import Data.Traversable (Traversable(traverse)) import GHC.Generics (Generic, Generic1) import Text.Read (Read(..), readListDefault, readListPrecDefault) diff --git a/libraries/base/Data/Functor/Contravariant.hs b/libraries/base/Data/Functor/Contravariant.hs index 0bfad271bb..7e6bb5d889 100644 --- a/libraries/base/Data/Functor/Contravariant.hs +++ b/libraries/base/Data/Functor/Contravariant.hs @@ -54,7 +54,6 @@ import Data.Functor.Sum import Data.Functor.Compose import Data.Monoid (Alt(..)) -import Data.Semigroup (Semigroup(..)) import Data.Proxy import GHC.Generics diff --git a/libraries/base/Data/Functor/Product.hs b/libraries/base/Data/Functor/Product.hs index d98d31ea59..8ed983b077 100644 --- a/libraries/base/Data/Functor/Product.hs +++ b/libraries/base/Data/Functor/Product.hs @@ -26,10 +26,7 @@ import Control.Monad (MonadPlus(..)) import Control.Monad.Fix (MonadFix(..)) import Control.Monad.Zip (MonadZip(mzipWith)) import Data.Data (Data) -import Data.Foldable (Foldable(foldMap)) import Data.Functor.Classes -import Data.Monoid (mappend) -import Data.Traversable (Traversable(traverse)) import GHC.Generics (Generic, Generic1) import Text.Read (Read(..), readListDefault, readListPrecDefault) diff --git a/libraries/base/Data/Functor/Sum.hs b/libraries/base/Data/Functor/Sum.hs index 68e60fe817..337db02eee 100644 --- a/libraries/base/Data/Functor/Sum.hs +++ b/libraries/base/Data/Functor/Sum.hs @@ -23,9 +23,7 @@ module Data.Functor.Sum ( import Control.Applicative ((<|>)) import Data.Data (Data) -import Data.Foldable (Foldable(foldMap)) import Data.Functor.Classes -import Data.Traversable (Traversable(traverse)) import GHC.Generics (Generic, Generic1) import Text.Read (Read(..), readListDefault, readListPrecDefault) diff --git a/libraries/base/Data/Semigroup.hs b/libraries/base/Data/Semigroup.hs index fad1b206c4..918351f62e 100644 --- a/libraries/base/Data/Semigroup.hs +++ b/libraries/base/Data/Semigroup.hs @@ -117,9 +117,6 @@ import Data.Bifunctor import Data.Bitraversable import Data.Coerce import Data.Data -import Data.Monoid (All (..), Any (..), Dual (..), Endo (..), - Product (..), Sum (..)) --- import qualified Data.Monoid as Monoid import GHC.Generics -- | A generalization of 'Data.List.cycle' to an arbitrary 'Semigroup'. diff --git a/libraries/base/GHC/Event/PSQ.hs b/libraries/base/GHC/Event/PSQ.hs index 6e13839491..55a39fcb81 100644 --- a/libraries/base/GHC/Event/PSQ.hs +++ b/libraries/base/GHC/Event/PSQ.hs @@ -49,7 +49,6 @@ import GHC.Event.Unique import GHC.Word (Word64) import GHC.Num (Num(..)) import GHC.Real (fromIntegral) -import GHC.Types (Int) #include "MachDeps.h" diff --git a/libraries/base/GHC/Generics.hs b/libraries/base/GHC/Generics.hs index 34425f2b5f..bd1a596f39 100644 --- a/libraries/base/GHC/Generics.hs +++ b/libraries/base/GHC/Generics.hs @@ -749,7 +749,7 @@ import GHC.Show ( Show(..), showString ) -- Needed for metadata import Data.Proxy ( Proxy(..) ) -import GHC.TypeLits ( Nat, Symbol, KnownSymbol, KnownNat, symbolVal, natVal ) +import GHC.TypeLits ( KnownSymbol, KnownNat, symbolVal, natVal ) -------------------------------------------------------------------------------- -- Representation types diff --git a/libraries/base/GHC/Show.hs b/libraries/base/GHC/Show.hs index a41bf81cb3..faaa629a76 100644 --- a/libraries/base/GHC/Show.hs +++ b/libraries/base/GHC/Show.hs @@ -53,7 +53,6 @@ import GHC.Base import GHC.List ((!!), foldr1, break) import GHC.Num import GHC.Stack.Types -import GHC.Types (TypeLitSort (..)) -- | The @shows@ functions return a function that prepends the diff --git a/libraries/base/GHC/StaticPtr.hs b/libraries/base/GHC/StaticPtr.hs index 34f720dc10..a9114e8363 100644 --- a/libraries/base/GHC/StaticPtr.hs +++ b/libraries/base/GHC/StaticPtr.hs @@ -50,7 +50,6 @@ module GHC.StaticPtr import Foreign.C.Types (CInt(..)) import Foreign.Marshal (allocaArray, peekArray, withArray) import Foreign.Ptr (castPtr) -import GHC.Exts (addrToAny#) import GHC.Ptr (Ptr(..), nullPtr) import GHC.Fingerprint (Fingerprint(..)) import GHC.Prim diff --git a/libraries/ghc-prim/GHC/Magic.hs b/libraries/ghc-prim/GHC/Magic.hs index ae95bfcbf4..0fc4fd92cd 100644 --- a/libraries/ghc-prim/GHC/Magic.hs +++ b/libraries/ghc-prim/GHC/Magic.hs @@ -32,7 +32,7 @@ module GHC.Magic ( inline, noinline, lazy, oneShot, runRW# ) where import GHC.Prim import GHC.CString () -import GHC.Types (RuntimeRep, TYPE) +import GHC.Types ( RuntimeRep ) -- | The call @inline f@ arranges that 'f' is inlined, regardless of -- its size. More precisely, the call @inline f@ rewrites to the diff --git a/testsuite/tests/module/mod177.stderr b/testsuite/tests/module/mod177.stderr index 2f9ffbbe0b..ea9306aa76 100644 --- a/testsuite/tests/module/mod177.stderr +++ b/testsuite/tests/module/mod177.stderr @@ -1,5 +1,5 @@ -mod177.hs:5:1: warning: [-Wunused-imports (in -Wextra)] +mod177.hs:4:1: warning: [-Wunused-imports (in -Wextra)] The import of ‘Data.Maybe’ is redundant except perhaps to import instances from ‘Data.Maybe’ To import instances alone, use: import Data.Maybe() diff --git a/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout index 3270089b9c..cfed45f6f1 100644 --- a/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout +++ b/testsuite/tests/overloadedrecflds/ghci/duplicaterecfldsghci01.stdout @@ -6,21 +6,21 @@ data T a = MkT {Ghci2.foo :: Bool, ...} :1:1: error: Ambiguous occurrence ‘foo’ - It could refer to either the field ‘foo’, - defined at :3:16 - or the field ‘foo’, defined at :4:18 + It could refer to + either the field ‘foo’, defined at :3:16 + or the field ‘foo’, defined at :4:18 :9:1: error: Ambiguous occurrence ‘foo’ - It could refer to either the field ‘foo’, - defined at :3:16 - or the field ‘foo’, defined at :4:18 + It could refer to + either the field ‘foo’, defined at :3:16 + or the field ‘foo’, defined at :4:18 True :1:1: error: Ambiguous occurrence ‘foo’ - It could refer to either the field ‘foo’, - defined at :3:16 - or the field ‘foo’, defined at :4:18 + It could refer to + either the field ‘foo’, defined at :3:16 + or the field ‘foo’, defined at :4:18 foo :: U -> Int 42 diff --git a/testsuite/tests/rename/should_compile/T13064.hs b/testsuite/tests/rename/should_compile/T13064.hs new file mode 100644 index 0000000000..6c8d79fb17 --- /dev/null +++ b/testsuite/tests/rename/should_compile/T13064.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -Wunused-imports #-} +module T13064 where + +import Control.Applicative +import Prelude (IO, pure) -- Import of 'pure' is redundant + +foo :: IO () +foo = () <$ pure () diff --git a/testsuite/tests/rename/should_compile/T13064.stderr b/testsuite/tests/rename/should_compile/T13064.stderr new file mode 100644 index 0000000000..3175a8563f --- /dev/null +++ b/testsuite/tests/rename/should_compile/T13064.stderr @@ -0,0 +1,3 @@ + +T13064.hs:5:1: warning: [-Wunused-imports (in -Wextra)] + The import of ‘pure’ from module ‘Prelude’ is redundant diff --git a/testsuite/tests/rename/should_compile/T4239.stdout b/testsuite/tests/rename/should_compile/T4239.stdout index a1f53d2c9e..d8f8909bc3 100644 --- a/testsuite/tests/rename/should_compile/T4239.stdout +++ b/testsuite/tests/rename/should_compile/T4239.stdout @@ -1 +1 @@ -import T4239A ( (·), type (:+++)((:---), X, (:+++)) ) +import T4239A ( (·), type (:+++)((:---), (:+++), X) ) diff --git a/testsuite/tests/rename/should_compile/all.T b/testsuite/tests/rename/should_compile/all.T index 3a90cbd667..bdda081e29 100644 --- a/testsuite/tests/rename/should_compile/all.T +++ b/testsuite/tests/rename/should_compile/all.T @@ -157,3 +157,4 @@ test('T14881', [], multimod_compile, ['T14881', '-W']) test('T14487', [], multimod_compile, ['T14487', '-v0']) test('T14747', [], multimod_compile, ['T14747', '-v0']) test('T15149', [], multimod_compile, ['T15149', '-v0']) +test('T13064', normal, compile, ['']) diff --git a/testsuite/tests/rename/should_fail/rnfail044.stderr b/testsuite/tests/rename/should_fail/rnfail044.stderr index 6dcf2ca8f9..39f7b77056 100644 --- a/testsuite/tests/rename/should_fail/rnfail044.stderr +++ b/testsuite/tests/rename/should_fail/rnfail044.stderr @@ -1,7 +1,8 @@ rnfail044.hs:5:12: error: Ambiguous occurrence ‘splitAt’ - It could refer to either ‘Data.List.splitAt’, - imported from ‘Prelude’ at rnfail044.hs:5:8 - (and originally defined in ‘GHC.List’) - or ‘A.splitAt’, defined at rnfail044.hs:8:3 + It could refer to + either ‘Prelude.splitAt’, + imported from ‘Prelude’ at rnfail044.hs:5:8 + (and originally defined in ‘GHC.List’) + or ‘A.splitAt’, defined at rnfail044.hs:8:3 -- cgit v1.2.1