Tune up the reporting of unused imports
Merge to STABLE
(I think the earlier change made it across)
(PS: the commit also does some trimming of
redundant imports. If they don't merge, just
discard them.)
My earlier fixes to the reporting of unused imports still missed
some obscure cases, some of which are now fixed by this commit.
I had to make the import-provenance data type yet richer, but in
fact it has more sharing now, so it may be cheaper on space.
There's still one infelicity. Consider
import M( x )
imoprt N( x )
where the same underlying 'x' is involved in both cases. Currently we
don't report a redundant import, because dropping either import would
change the qualified names in scope (M.x, N.x). But if the qualified
names aren't used, the import is indeed redundant. Sadly we don't know
that, because we only know what Names are used. Left for the future!
There's a comment in RnNames.warnDuplicateImports
This commit also trims quite a few redundant imports disovered
by the new setup.
17 files changed:
lookupGRE_RdrName, lookupGRE_Name,
-- GlobalRdrElt, Provenance, ImportSpec
lookupGRE_RdrName, lookupGRE_Name,
-- GlobalRdrElt, Provenance, ImportSpec
- GlobalRdrElt(..), Provenance(..), ImportSpec(..),
- isLocalGRE, unQualOK,
- pprNameProvenance
+ GlobalRdrElt(..), isLocalGRE, unQualOK,
+ Provenance(..), pprNameProvenance,
+ ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
+ importSpecLoc, importSpecModule
) where
#include "HsVersions.h"
) where
#include "HsVersions.h"
unQualOK :: GlobalRdrElt -> Bool
-- An unqualifed version of this thing is in scope
unQualOK (GRE {gre_prov = LocalDef _}) = True
unQualOK :: GlobalRdrElt -> Bool
-- An unqualifed version of this thing is in scope
unQualOK (GRE {gre_prov = LocalDef _}) = True
-unQualOK (GRE {gre_prov = Imported is}) = not (all is_qual is)
+unQualOK (GRE {gre_prov = Imported is}) = not (all (is_qual . is_decl) is)
hasQual :: Module -> GlobalRdrElt -> Bool
-- A qualified version of this thing is in scope
hasQual mod (GRE {gre_prov = LocalDef m}) = m == mod
hasQual :: Module -> GlobalRdrElt -> Bool
-- A qualified version of this thing is in scope
hasQual mod (GRE {gre_prov = LocalDef m}) = m == mod
-hasQual mod (GRE {gre_prov = Imported is}) = any ((== mod) . is_as) is
+hasQual mod (GRE {gre_prov = Imported is}) = any ((== mod) . is_as . is_decl) is
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
plusGlobalRdrEnv :: GlobalRdrEnv -> GlobalRdrEnv -> GlobalRdrEnv
plusGlobalRdrEnv env1 env2 = plusOccEnv_C (foldr insertGRE) env1 env2
%************************************************************************
The "provenance" of something says how it came to be in scope.
%************************************************************************
The "provenance" of something says how it came to be in scope.
+It's quite elaborate so that we can give accurate unused-name warnings.
\begin{code}
data Provenance
= LocalDef -- Defined locally
Module
\begin{code}
data Provenance
= LocalDef -- Defined locally
Module
[ImportSpec] -- INVARIANT: non-empty
[ImportSpec] -- INVARIANT: non-empty
-data ImportSpec -- Describes a particular import declaration
- -- Shared among all the Provenaces for a
- -- import-all declaration; otherwise it's done
- -- per explictly-named item
- = ImportSpec {
+data ImportSpec = ImpSpec { is_decl :: ImpDeclSpec,
+ is_item :: ImpItemSpec }
+ deriving( Eq, Ord )
+
+data ImpDeclSpec -- Describes a particular import declaration
+ -- Shared among all the Provenaces for that decl
+ = ImpDeclSpec {
is_mod :: Module, -- 'import Muggle'
-- Note the Muggle may well not be
-- the defining module for this thing!
is_as :: Module, -- 'as M' (or 'Muggle' if there is no 'as' clause)
is_qual :: Bool, -- True <=> qualified (only)
is_mod :: Module, -- 'import Muggle'
-- Note the Muggle may well not be
-- the defining module for this thing!
is_as :: Module, -- 'as M' (or 'Muggle' if there is no 'as' clause)
is_qual :: Bool, -- True <=> qualified (only)
- is_explicit :: Bool, -- True <=> explicit import (see below)
- is_loc :: SrcSpan -- Location of import item
+ is_dloc :: SrcSpan -- Location of import declaration
+ }
+
+data ImpItemSpec -- Describes import info a particular Name
+ = ImpAll -- The import had no import list,
+ -- or had a hiding list
+
+ | ImpSome { -- The import had an import list
+ is_explicit :: Bool,
+ is_iloc :: SrcSpan -- Location of the import item
}
-- The is_explicit field is True iff the thing was named
-- *explicitly* in the import specs rather
}
-- The is_explicit field is True iff the thing was named
-- *explicitly* in the import specs rather
- -- than being imported as part of a group
- -- e.g. import B
- -- import C( T(..) )
- -- Here, everything imported by B, and the constructors of T
- -- are not named explicitly; only T is named explicitly.
- -- This info is used when warning of unused names.
- --
- -- We keep ImportSpec separate from the Bool so that the
- -- former can be shared between all Provenances for a particular
- -- import declaration.
+ -- than being imported as part of a "..." group
+ -- e.g. import C( T(..) )
+ -- Here the constructors of T are not named explicitly;
+ -- only T is named explicitly.
+
+importSpecLoc :: ImportSpec -> SrcSpan
+importSpecLoc (ImpSpec decl ImpAll) = is_dloc decl
+importSpecLoc (ImpSpec _ item) = is_iloc item
+
+importSpecModule :: ImportSpec -> Module
+importSpecModule is = is_mod (is_decl is)
-- Note [Comparing provenance]
-- Comparison of provenance is just used for grouping
-- Note [Comparing provenance]
-- Comparison of provenance is just used for grouping
instance Eq Provenance where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Eq Provenance where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
-instance Eq ImportSpec where
+instance Eq ImpDeclSpec where
+ p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
+
+instance Eq ImpItemSpec where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Ord Provenance where
p1 == p2 = case p1 `compare` p2 of EQ -> True; _ -> False
instance Ord Provenance where
compare (Imported is1) (Imported is2) = compare (head is1)
{- See Note [Comparing provenance] -} (head is2)
compare (Imported is1) (Imported is2) = compare (head is1)
{- See Note [Comparing provenance] -} (head is2)
-instance Ord ImportSpec where
+instance Ord ImpDeclSpec where
compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`
compare is1 is2 = (is_mod is1 `compare` is_mod is2) `thenCmp`
- (is_loc is1 `compare` is_loc is2)
+ (is_dloc is1 `compare` is_dloc is2)
+
+instance Ord ImpItemSpec where
+ compare is1 is2 = is_iloc is1 `compare` is_iloc is2
| otherwise = empty
instance Outputable ImportSpec where
| otherwise = empty
instance Outputable ImportSpec where
- ppr imp_spec
- = ptext SLIT("imported from") <+> ppr (is_mod imp_spec)
- <+> ptext SLIT("at") <+> ppr (is_loc imp_spec)
+ ppr imp_spec@(ImpSpec imp_decl _)
+ = ptext SLIT("imported from") <+> ppr (is_mod imp_decl)
+ <+> ptext SLIT("at") <+> ppr (importSpecLoc imp_spec)
import DynFlags ( DynFlag(..), DynFlags(..), dopt, GhcMode(..) )
import StaticFlags ( opt_SccProfilingOn )
import DriverPhases ( isHsBoot )
import DynFlags ( DynFlag(..), DynFlags(..), dopt, GhcMode(..) )
import StaticFlags ( opt_SccProfilingOn )
import DriverPhases ( isHsBoot )
-import HscTypes ( ModGuts(..), ModGuts, HscEnv(..),
+import HscTypes ( ModGuts(..), HscEnv(..),
Dependencies(..), TypeEnv, IsBootInterface )
import HsSyn ( RuleDecl(..), RuleBndr(..), HsExpr(..), LHsExpr,
HsBindGroup(..), LRuleDecl, HsBind(..) )
Dependencies(..), TypeEnv, IsBootInterface )
import HsSyn ( RuleDecl(..), RuleBndr(..), HsExpr(..), LHsExpr,
HsBindGroup(..), LRuleDecl, HsBind(..) )
import DsExpr () -- Forces DsExpr to be compiled; DsBinds only
-- depends on DsExpr.hi-boot.
import Module ( Module, moduleEnvElts, delModuleEnv, moduleFS )
import DsExpr () -- Forces DsExpr to be compiled; DsBinds only
-- depends on DsExpr.hi-boot.
import Module ( Module, moduleEnvElts, delModuleEnv, moduleFS )
import RdrName ( GlobalRdrEnv )
import NameSet
import VarEnv
import RdrName ( GlobalRdrEnv )
import NameSet
import VarEnv
import ForeignCall ( ForeignCall(..), CCallSpec(..), CCallTarget(..), Safety,
CCallConv(..), CLabelString )
import DataCon ( splitProductType_maybe, dataConSourceArity, dataConWrapId )
import ForeignCall ( ForeignCall(..), CCallSpec(..), CCallTarget(..), Safety,
CCallConv(..), CLabelString )
import DataCon ( splitProductType_maybe, dataConSourceArity, dataConWrapId )
-import ForeignCall ( ForeignCall, CCallTarget(..) )
import TcType ( tcSplitTyConApp_maybe )
import Type ( Type, isUnLiftedType, mkFunTys, mkFunTy,
import TcType ( tcSplitTyConApp_maybe )
import Type ( Type, isUnLiftedType, mkFunTys, mkFunTy,
-- So WATCH OUT; check each use of split*Ty functions.
-- Sigh. This is a pain.
-- So WATCH OUT; check each use of split*Ty functions.
-- Sigh. This is a pain.
-import TcType ( tcSplitAppTy, tcSplitFunTys, tcTyConAppTyCon, tcTyConAppArgs,
+import TcType ( tcSplitAppTy, tcSplitFunTys, tcTyConAppTyCon,
tcTyConAppArgs, isUnLiftedType, Type, mkAppTy )
import Type ( funArgTy, splitFunTys, isUnboxedTupleType, mkFunTy )
import CoreSyn
tcTyConAppArgs, isUnLiftedType, Type, mkAppTy )
import Type ( funArgTy, splitFunTys, isUnboxedTupleType, mkFunTy )
import CoreSyn
import PrelInfo ( rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID )
import DataCon ( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArgTys )
import DataCon ( isVanillaDataCon )
import PrelInfo ( rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID )
import DataCon ( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArgTys )
import DataCon ( isVanillaDataCon )
import TyCon ( FieldLabel, tyConDataCons )
import TysWiredIn ( tupleCon )
import BasicTypes ( RecFlag(..), Boxity(..), ipNameName )
import TyCon ( FieldLabel, tyConDataCons )
import TysWiredIn ( tupleCon )
import BasicTypes ( RecFlag(..), Boxity(..), ipNameName )
mfixName )
import SrcLoc ( Located(..), unLoc, getLoc, noLoc )
import Util ( zipEqual, zipWithEqual )
mfixName )
import SrcLoc ( Located(..), unLoc, getLoc, noLoc )
import Util ( zipEqual, zipWithEqual )
-import Maybe ( fromJust )
import Bag ( bagToList )
import Outputable
import FastString
import Bag ( bagToList )
import Outputable
import FastString
import Bag ( emptyBag, snocBag, Bag )
import DataCon ( DataCon )
import TyCon ( TyCon )
import Bag ( emptyBag, snocBag, Bag )
import DataCon ( DataCon )
import TyCon ( TyCon )
-import DataCon ( DataCon )
import Id ( mkSysLocal, setIdUnique, Id )
import Module ( Module )
import Var ( TyVar, setTyVarUnique )
import Id ( mkSysLocal, setIdUnique, Id )
import Module ( Module )
import Var ( TyVar, setTyVarUnique )
import Class ( mkClass, Class( classTyCon), FunDep, DefMeth(..) )
import TyCon ( FieldLabel, mkSynTyCon, mkAlgTyCon, visibleDataCons, tyConStupidTheta,
tyConDataCons, isNewTyCon, mkClassTyCon, TyCon( tyConTyVars ),
import Class ( mkClass, Class( classTyCon), FunDep, DefMeth(..) )
import TyCon ( FieldLabel, mkSynTyCon, mkAlgTyCon, visibleDataCons, tyConStupidTheta,
tyConDataCons, isNewTyCon, mkClassTyCon, TyCon( tyConTyVars ),
- ArgVrcs, AlgTyConRhs(..), newTyConRhs, visibleDataCons )
+ ArgVrcs, AlgTyConRhs(..), newTyConRhs )
import Type ( mkArrowKinds, liftedTypeKind, typeKind, tyVarsOfTypes, tyVarsOfPred,
splitTyConApp_maybe, mkPredTys, mkTyVarTys, ThetaType, Type,
substTyWith, zipTopTvSubst, substTheta )
import Type ( mkArrowKinds, liftedTypeKind, typeKind, tyVarsOfTypes, tyVarsOfPred,
splitTyConApp_maybe, mkPredTys, mkTyVarTys, ThetaType, Type,
substTyWith, zipTopTvSubst, substTheta )
import TcRnMonad
import TcRnTypes ( mkModDeps )
import HscTypes ( ModIface(..), ModDetails(..),
import TcRnMonad
import TcRnTypes ( mkModDeps )
import HscTypes ( ModIface(..), ModDetails(..),
- ModGuts(..), ModGuts, IfaceExport,
+ ModGuts(..), IfaceExport,
HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
ModSummary(..), msHiFilePath,
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
ModSummary(..), msHiFilePath,
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
import DynFlags
import StaticFlags ( v_Ld_inputs, opt_Static, WayName(..) )
import Config
import DynFlags
import StaticFlags ( v_Ld_inputs, opt_Static, WayName(..) )
import Config
-import RdrName ( GlobalRdrEnv )
import Panic
import Util
import StringBuffer ( hGetStringBuffer )
import Panic
import Util
import StringBuffer ( hGetStringBuffer )
#ifdef GHCI
import qualified Linker
import Linker ( HValue, extendLinkEnv )
#ifdef GHCI
import qualified Linker
import Linker ( HValue, extendLinkEnv )
-import NameEnv ( lookupNameEnv )
import TcRnDriver ( getModuleContents, tcRnLookupRdrName,
getModuleExports )
import TcRnDriver ( getModuleContents, tcRnLookupRdrName,
getModuleExports )
-import RdrName ( plusGlobalRdrEnv, Provenance(..), ImportSpec(..),
+import RdrName ( plusGlobalRdrEnv, Provenance(..),
+ ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
emptyGlobalRdrEnv, mkGlobalRdrEnv )
import HscMain ( hscGetInfo, GetInfoResult, hscParseIdentifier,
hscStmt, hscTcExpr, hscKcType )
emptyGlobalRdrEnv, mkGlobalRdrEnv )
import HscMain ( hscGetInfo, GetInfoResult, hscParseIdentifier,
hscStmt, hscTcExpr, hscKcType )
import VarEnv ( emptyTidyEnv )
import GHC.Exts ( unsafeCoerce# )
import IfaceSyn ( IfaceDecl )
import VarEnv ( emptyTidyEnv )
import GHC.Exts ( unsafeCoerce# )
import IfaceSyn ( IfaceDecl )
-import Name ( getName, nameModule_maybe )
-import SrcLoc ( mkSrcLoc, srcLocSpan, interactiveSrcLoc )
-import Bag ( unitBag, emptyBag )
+import SrcLoc ( srcLocSpan, interactiveSrcLoc )
#endif
import Packages ( initPackages )
import NameSet ( NameSet, nameSetToList, elemNameSet )
#endif
import Packages ( initPackages )
import NameSet ( NameSet, nameSetToList, elemNameSet )
-import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName, gre_name,
+import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName,
globalRdrEnvElts )
import HsSyn
import Type ( Kind, Type, dropForAlls )
globalRdrEnvElts )
import HsSyn
import Type ( Kind, Type, dropForAlls )
import Outputable
import SysTools ( cleanTempFilesExcept )
import BasicTypes ( SuccessFlag(..), succeeded, failed )
import Outputable
import SysTools ( cleanTempFilesExcept )
import BasicTypes ( SuccessFlag(..), succeeded, failed )
-import Maybes ( orElse, expectJust, mapCatMaybes )
import TcType ( tcSplitSigmaTy, isDictTy )
import FastString ( mkFastString )
import Directory ( getModificationTime, doesFileExist )
import TcType ( tcSplitSigmaTy, isDictTy )
import FastString ( mkFastString )
import Directory ( getModificationTime, doesFileExist )
-import Maybe ( isJust, isNothing, fromJust, fromMaybe, catMaybes )
-import Maybes ( expectJust )
+import Maybe ( isJust, isNothing, fromJust )
+import Maybes ( orElse, expectJust, mapCatMaybes )
import List ( partition, nub )
import qualified List
import List ( partition, nub )
import qualified List
-import Monad ( unless, when, foldM )
+import Monad ( unless, when )
import System ( exitWith, ExitCode(..) )
import Time ( ClockTime )
import EXCEPTION as Exception hiding (handle)
import System ( exitWith, ExitCode(..) )
import Time ( ClockTime )
import EXCEPTION as Exception hiding (handle)
vanillaProv :: Module -> Provenance
-- We're building a GlobalRdrEnv as if the user imported
-- all the specified modules into the global interactive module
vanillaProv :: Module -> Provenance
-- We're building a GlobalRdrEnv as if the user imported
-- all the specified modules into the global interactive module
-vanillaProv mod = Imported [ImportSpec { is_mod = mod, is_as = mod,
- is_qual = False, is_explicit = False,
- is_loc = srcLocSpan interactiveSrcLoc }]
+vanillaProv mod = Imported [ImpSpec { is_decl = decl, is_item = ImpAll}]
+ where
+ decl = ImpDeclSpec { is_mod = mod, is_as = mod,
+ is_qual = False,
+ is_dloc = srcLocSpan interactiveSrcLoc }
checkModuleExists :: HscEnv -> HomePackageTable -> Module -> IO ()
checkModuleExists hsc_env hpt mod =
checkModuleExists :: HscEnv -> HomePackageTable -> Module -> IO ()
checkModuleExists hsc_env hpt mod =
#ifdef GHCI
import HsSyn ( Stmt(..), LHsExpr, LStmt, LHsType )
#ifdef GHCI
import HsSyn ( Stmt(..), LHsExpr, LStmt, LHsType )
-import IfaceSyn ( IfaceDecl, IfaceInst )
import Module ( Module )
import CodeOutput ( outputForeignStubs )
import ByteCodeGen ( byteCodeGen, coreExprToBCOs )
import Module ( Module )
import CodeOutput ( outputForeignStubs )
import ByteCodeGen ( byteCodeGen, coreExprToBCOs )
import CorePrep ( corePrepExpr )
import Flattening ( flattenExpr )
import TcRnDriver ( tcRnStmt, tcRnExpr, tcRnGetInfo, GetInfoResult, tcRnType )
import CorePrep ( corePrepExpr )
import Flattening ( flattenExpr )
import TcRnDriver ( tcRnStmt, tcRnExpr, tcRnGetInfo, GetInfoResult, tcRnType )
-import RdrName ( rdrNameOcc )
-import OccName ( occNameUserString )
import Type ( Type )
import PrelNames ( iNTERACTIVE )
import Kind ( Kind )
import CoreLint ( lintUnfolding )
import DsMeta ( templateHaskellNames )
import Type ( Type )
import PrelNames ( iNTERACTIVE )
import Kind ( Kind )
import CoreLint ( lintUnfolding )
import DsMeta ( templateHaskellNames )
-import BasicTypes ( Fixity )
-import SrcLoc ( SrcLoc, noSrcLoc )
+import SrcLoc ( noSrcLoc )
import VarEnv ( emptyTidyEnv )
#endif
import VarEnv ( emptyTidyEnv )
#endif
import CodeOutput ( codeOutput )
import DynFlags
import CodeOutput ( codeOutput )
import DynFlags
-import DriverPhases ( HscSource(..) )
import ErrUtils
import UniqSupply ( mkSplitUniqSupply )
import ErrUtils
import UniqSupply ( mkSplitUniqSupply )
import HsSyn -- Lots of it
import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc,
import HsSyn -- Lots of it
import RdrName ( RdrName, isRdrTyVar, mkUnqual, rdrNameOcc,
- isRdrTyVar, isRdrDataCon, isUnqual, getRdrName, isQual,
+ isRdrDataCon, isUnqual, getRdrName, isQual,
setRdrNameSpace )
import BasicTypes ( RecFlag(..), maxPrecedence )
import Lexer ( P, failSpanMsgP )
setRdrNameSpace )
import BasicTypes ( RecFlag(..), maxPrecedence )
import Lexer ( P, failSpanMsgP )
import Kind ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
import Unique ( incrUnique, mkTupleTyConUnique,
mkTupleDataConUnique, mkPArrDataConUnique )
import Kind ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
import Unique ( incrUnique, mkTupleTyConUnique,
mkTupleDataConUnique, mkPArrDataConUnique )
import Array
import FastString
import Outputable
import Array
import FastString
import Outputable
isExact_maybe, isSrcRdrName,
GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv,
isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
isExact_maybe, isSrcRdrName,
GlobalRdrElt(..), GlobalRdrEnv, lookupGlobalRdrEnv,
isLocalGRE, extendLocalRdrEnv, elemLocalRdrEnv, lookupLocalRdrEnv,
- Provenance(..), pprNameProvenance, ImportSpec(..)
+ Provenance(..), pprNameProvenance,
+ importSpecLoc, importSpecModule
)
import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity )
import TcRnMonad
)
import HscTypes ( availNames, ModIface(..), FixItem(..), lookupFixity )
import TcRnMonad
where
(loc,msg) = case prov of
Just (Imported is)
where
(loc,msg) = case prov of
Just (Imported is)
- -> (is_loc imp_spec, imp_from (is_mod imp_spec))
+ -> (importSpecLoc imp_spec, imp_from (importSpecModule imp_spec))
where
imp_spec = head is
other -> (srcLocSpan (nameSrcLoc name), unused_msg)
where
imp_spec = head is
other -> (srcLocSpan (nameSrcLoc name), unused_msg)
GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
extendGlobalRdrEnv, lookupGlobalRdrEnv, unQualOK, lookupGRE_Name,
GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
extendGlobalRdrEnv, lookupGlobalRdrEnv, unQualOK, lookupGRE_Name,
- Provenance(..), ImportSpec(..),
- isLocalGRE, pprNameProvenance )
+ Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
+ importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance )
import Outputable
import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
import SrcLoc ( Located(..), mkGeneralSrcSpan,
import Outputable
import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
import SrcLoc ( Located(..), mkGeneralSrcSpan,
qual_mod_name = case as_mod of
Nothing -> imp_mod_name
Just another_name -> another_name
qual_mod_name = case as_mod of
Nothing -> imp_mod_name
Just another_name -> another_name
- imp_spec = ImportSpec { is_mod = imp_mod_name, is_qual = qual_only,
- is_loc = loc, is_as = qual_mod_name, is_explicit = False }
+ imp_spec = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
+ is_dloc = loc, is_as = qual_mod_name }
in
-- Get the total imports, and filter them according to the import list
ifaceExportNames filtered_exports `thenM` \ total_avails ->
in
-- Get the total imports, and filter them according to the import list
ifaceExportNames filtered_exports `thenM` \ total_avails ->
\begin{code}
filterImports :: ModIface
\begin{code}
filterImports :: ModIface
- -> ImportSpec -- The span for the entire import decl
+ -> ImpDeclSpec -- The span for the entire import decl
-> Maybe (Bool, [Located (IE RdrName)]) -- Import spec; True => hiding
-> NameSet -- What's available
-> RnM (NameSet, -- What's imported (qualified or unqualified)
-> Maybe (Bool, [Located (IE RdrName)]) -- Import spec; True => hiding
-> NameSet -- What's available
-> RnM (NameSet, -- What's imported (qualified or unqualified)
-- Complains if import spec mentions things that the module doesn't export
-- Warns/informs if import spec contains duplicates.
-- Complains if import spec mentions things that the module doesn't export
-- Warns/informs if import spec contains duplicates.
-mkGenericRdrEnv imp_spec names
+mkGenericRdrEnv decl_spec names
= mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
| name <- nameSetToList names ]
= mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
| name <- nameSetToList names ]
+ where
+ imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
-filterImports iface imp_spec Nothing all_names
- = returnM (all_names, mkGenericRdrEnv imp_spec all_names)
+filterImports iface decl_spec Nothing all_names
+ = returnM (all_names, mkGenericRdrEnv decl_spec all_names)
-filterImports iface imp_spec (Just (want_hiding, import_items)) all_names
+filterImports iface decl_spec (Just (want_hiding, import_items)) all_names
= mappM (addLocM get_item) import_items `thenM` \ gres_s ->
let
gres = concat gres_s
= mappM (addLocM get_item) import_items `thenM` \ gres_s ->
let
gres = concat gres_s
keep n = not (n `elemNameSet` specified_names)
pruned_avails = filterNameSet keep all_names
in
keep n = not (n `elemNameSet` specified_names)
pruned_avails = filterNameSet keep all_names
in
- return (pruned_avails, mkGenericRdrEnv imp_spec pruned_avails)
+ return (pruned_avails, mkGenericRdrEnv decl_spec pruned_avails)
where
occ_env :: OccEnv Name -- Maps OccName to corresponding Name
where
occ_env :: OccEnv Name -- Maps OccName to corresponding Name
sub_env :: NameEnv [Name]
sub_env = mkSubNameEnv all_names
sub_env :: NameEnv [Name]
sub_env = mkSubNameEnv all_names
- bale_out item = addErr (badImportItemErr iface imp_spec item) `thenM_`
+ bale_out item = addErr (badImportItemErr iface decl_spec item) `thenM_`
returnM []
succeed_with :: Bool -> [Name] -> RnM [GlobalRdrElt]
returnM []
succeed_with :: Bool -> [Name] -> RnM [GlobalRdrElt]
; returnM (map (mk_gre loc) names) }
where
mk_gre loc name = GRE { gre_name = name,
; returnM (map (mk_gre loc) names) }
where
mk_gre loc name = GRE { gre_name = name,
- gre_prov = Imported [imp_spec'] }
+ gre_prov = Imported [imp_spec] }
- imp_spec' = imp_spec { is_loc = loc, is_explicit = explicit }
- explicit = all_explicit || isNothing (nameParent_maybe name)
+ imp_spec = ImpSpec { is_decl = decl_spec, is_item = item_spec }
+ item_spec = ImpSome { is_explicit = explicit, is_iloc = loc }
+ explicit = all_explicit || isNothing (nameParent_maybe name)
get_item :: IE RdrName -> RnM [GlobalRdrElt]
-- Empty result for a bad item.
get_item :: IE RdrName -> RnM [GlobalRdrElt]
-- Empty result for a bad item.
check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
| name `elemNameSet` used_names
, Just deprec_txt <- lookupDeprec hpt pit name
check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
| name `elemNameSet` used_names
, Just deprec_txt <- lookupDeprec hpt pit name
- = setSrcSpan (is_loc imp_spec) $
+ = setSrcSpan (importSpecLoc imp_spec) $
addWarn (sep [ptext SLIT("Deprecated use of") <+>
occNameFlavour (nameOccName name) <+>
quotes (ppr name),
addWarn (sep [ptext SLIT("Deprecated use of") <+>
occNameFlavour (nameOccName name) <+>
quotes (ppr name),
(ppr deprec_txt) ])
where
name_mod = nameModule name
(ppr deprec_txt) ])
where
name_mod = nameModule name
- imp_mod = is_mod imp_spec
+ imp_mod = importSpecModule imp_spec
imp_msg = ptext SLIT("imported from") <+> ppr imp_mod <> extra
extra | imp_mod == name_mod = empty
| otherwise = ptext SLIT(", but defined in") <+> ppr name_mod
imp_msg = ptext SLIT("imported from") <+> ppr imp_mod <> extra
extra | imp_mod == name_mod = empty
| otherwise = ptext SLIT(", but defined in") <+> ppr name_mod
unused_imports :: [GlobalRdrElt]
unused_imports = filter unused_imp defined_but_not_used
unused_imp (GRE {gre_prov = Imported imp_specs})
unused_imports :: [GlobalRdrElt]
unused_imports = filter unused_imp defined_but_not_used
unused_imp (GRE {gre_prov = Imported imp_specs})
- = not (all (module_unused . is_mod) imp_specs)
- && any is_explicit imp_specs
+ = not (all (module_unused . importSpecModule) imp_specs)
+ && or [exp | ImpSpec { is_item = ImpSome { is_explicit = exp } } <- imp_specs]
-- Don't complain about unused imports if we've already said the
-- entire import is unused
unused_imp other = False
-- Don't complain about unused imports if we've already said the
-- entire import is unused
unused_imp other = False
-- construct minimal imports that import the name by (one of)
-- the same route(s) as the programmer originally did.
add_name (GRE {gre_name = n, gre_prov = Imported imp_specs}) acc
-- construct minimal imports that import the name by (one of)
-- the same route(s) as the programmer originally did.
add_name (GRE {gre_name = n, gre_prov = Imported imp_specs}) acc
- = addToFM_C plusAvailEnv acc (is_mod (head imp_specs))
+ = addToFM_C plusAvailEnv acc (importSpecModule (head imp_specs))
(unitAvailEnv (mk_avail n (nameParent_maybe n)))
add_name other acc
= acc
(unitAvailEnv (mk_avail n (nameParent_maybe n)))
add_name other acc
= acc
, pr <- redundants imps ]
where
warn name (red_imp, cov_imp)
, pr <- redundants imps ]
where
warn name (red_imp, cov_imp)
- = addWarnAt (is_loc red_imp)
+ = addWarnAt (importSpecLoc red_imp)
(vcat [ptext SLIT("Redundant import of:") <+> quotes pp_name,
ptext SLIT("It is also") <+> ppr cov_imp])
where
(vcat [ptext SLIT("Redundant import of:") <+> quotes pp_name,
ptext SLIT("It is also") <+> ppr cov_imp])
where
- pp_name | is_qual red_imp = ppr (is_as red_imp) <> dot <> ppr occ
+ pp_name | is_qual red_decl = ppr (is_as red_decl) <> dot <> ppr occ
| otherwise = ppr occ
occ = nameOccName name
| otherwise = ppr occ
occ = nameOccName name
+ red_decl = is_decl red_imp
redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
-- The returned pair is (redundant-import, covering-import)
redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
-- The returned pair is (redundant-import, covering-import)
-- "red_imp" is a putative redundant import
-- "cov_imp" potentially covers it
-- "red_imp" is a putative redundant import
-- "cov_imp" potentially covers it
- -- This test decides
- covers red_imp cov_imp
+ -- This test decides whether red_imp could be dropped
+ --
+ -- NOTE: currently the test does not warn about
+ -- import M( x )
+ -- imoprt N( x )
+ -- even if the same underlying 'x' is involved, because dropping
+ -- either import would change the qualified names in scope (M.x, N.x)
+ -- But if the qualified names aren't used, the import is indeed redundant
+ -- Sadly we don't know that. Oh well.
+ covers red_imp@(ImpSpec { is_decl = red_decl, is_item = red_item })
+ cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
| red_loc == cov_loc
= False -- Ignore diagonal elements
| red_loc == cov_loc
= False -- Ignore diagonal elements
- | not (is_as red_imp == is_as cov_imp)
+ | not (is_as red_decl == is_as cov_decl)
= False -- They bring into scope different qualified names
= False -- They bring into scope different qualified names
- | not (is_qual red_imp) && is_qual cov_imp
+ | not (is_qual red_decl) && is_qual cov_decl
= False -- Covering one doesn't bring unqualified name into scope
= False -- Covering one doesn't bring unqualified name into scope
- | is_explicit red_imp
- = not cov_explicit -- Redundant one is explicit and covering one isn't
+ | red_selective
+ = not cov_selective -- Redundant one is selective and covering one isn't
|| red_later -- Both are explicit; tie-break using red_later
| otherwise
|| red_later -- Both are explicit; tie-break using red_later
| otherwise
- = not cov_explicit -- Neither import is explicit
- && (is_mod red_imp == is_mod cov_imp) -- They import the same module
+ = not cov_selective -- Neither import is selective
+ && (is_mod red_decl == is_mod cov_decl) -- They import the same module
&& red_later -- Tie-break
where
&& red_later -- Tie-break
where
- cov_explicit = is_explicit cov_imp
- red_loc = is_loc red_imp
- cov_loc = is_loc cov_imp
+ red_loc = importSpecLoc red_imp
+ cov_loc = importSpecLoc cov_imp
red_later = red_loc > cov_loc
red_later = red_loc > cov_loc
+ cov_selective = selectiveImpItem cov_item
+ red_selective = selectiveImpItem red_item
+
+selectiveImpItem :: ImpItemSpec -> Bool
+selectiveImpItem ImpAll = False
+selectiveImpItem (ImpSome {}) = True
-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
printMinimalImports :: FiniteMap Module AvailEnv -- Minimal imports
-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
printMinimalImports :: FiniteMap Module AvailEnv -- Minimal imports
%************************************************************************
\begin{code}
%************************************************************************
\begin{code}
-badImportItemErr iface imp_spec ie
- = sep [ptext SLIT("Module"), quotes (ppr (is_mod imp_spec)), source_import,
+badImportItemErr iface decl_spec ie
+ = sep [ptext SLIT("Module"), quotes (ppr (is_mod decl_spec)), source_import,
ptext SLIT("does not export"), quotes (ppr ie)]
where
source_import | mi_boot iface = ptext SLIT("(hi-boot interface)")
ptext SLIT("does not export"), quotes (ppr ie)]
where
source_import | mi_boot iface = ptext SLIT("(hi-boot interface)")
import SimplMonad
import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass )
import CoreLint ( endPass )
import SimplMonad
import ErrUtils ( dumpIfSet, dumpIfSet_dyn, showPass )
import CoreLint ( endPass )
-import VarEnv ( mkInScopeSet )
import FloatIn ( floatInwards )
import FloatOut ( floatOutwards )
import Id ( Id, modifyIdInfo, idInfo, isExportedId, isLocalId,
import FloatIn ( floatInwards )
import FloatOut ( floatOutwards )
import Id ( Id, modifyIdInfo, idInfo, isExportedId, isLocalId,
)
import TcType ( Type, TcType, TcThetaType, TcTyVarSet, TcTyVar, TcPredType,
PredType(..), SkolemInfo(..), typeKind, mkSigmaTy,
)
import TcType ( Type, TcType, TcThetaType, TcTyVarSet, TcTyVar, TcPredType,
PredType(..), SkolemInfo(..), typeKind, mkSigmaTy,
- tcSplitForAllTys, tcSplitForAllTys, mkFunTy,
+ tcSplitForAllTys, mkFunTy,
tcSplitPhiTy, tcIsTyVarTy, tcSplitDFunHead,
isIntTy,isFloatTy, isIntegerTy, isDoubleTy,
tcSplitPhiTy, tcIsTyVarTy, tcSplitDFunHead,
isIntTy,isFloatTy, isIntegerTy, isDoubleTy,
- tcIsTyVarTy, mkPredTy, mkTyVarTy, mkTyVarTys,
+ mkPredTy, mkTyVarTy, mkTyVarTys,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
isClassPred, isTyVarClassPred, isLinearPred,
getClassPredTys, getClassPredTys_maybe, mkPredName,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tidyPred,
isClassPred, isTyVarClassPred, isLinearPred,
getClassPredTys, getClassPredTys_maybe, mkPredName,
#include "HsVersions.h"
import {-# SOURCE #-} TcUnify( unifyTauTy )
#include "HsVersions.h"
import {-# SOURCE #-} TcUnify( unifyTauTy )
import HsSyn ( HsBind(..), HsExpr(..), LHsExpr, emptyLHsBinds )
import TcHsSyn ( TcId, TcDictBinds, mkHsApp, mkHsTyApp, mkHsDictApp )
import HsSyn ( HsBind(..), HsExpr(..), LHsExpr, emptyLHsBinds )
import TcHsSyn ( TcId, TcDictBinds, mkHsApp, mkHsTyApp, mkHsDictApp )
Inst, pprInsts, pprDictsInFull, pprInstInFull, tcGetInstEnvs,
isInheritableInst, pprDictsTheta
)
Inst, pprInsts, pprDictsInFull, pprInstInFull, tcGetInstEnvs,
isInheritableInst, pprDictsTheta
)
-import TcEnv ( tcGetGlobalTyVars, tcLookupId, findGlobals, pprBinders )
+import TcEnv ( tcGetGlobalTyVars, tcLookupId, findGlobals, pprBinders,
+ lclEnvElts, tcMetaTy )
import InstEnv ( lookupInstEnv, classInstances, pprInstances )
import TcMType ( zonkTcTyVarsAndFV, tcInstTyVars, checkAmbiguity )
import TcType ( TcTyVar, TcTyVarSet, ThetaType, TcPredType,
import InstEnv ( lookupInstEnv, classInstances, pprInstances )
import TcMType ( zonkTcTyVarsAndFV, tcInstTyVars, checkAmbiguity )
import TcType ( TcTyVar, TcTyVarSet, ThetaType, TcPredType,