Commit 4a587049 authored by simonpj's avatar simonpj
Browse files

[project @ 2005-05-19 11:15:40 by simonpj]

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.
parent f01b31dd
......@@ -32,9 +32,10 @@ module RdrName (
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"
......@@ -373,12 +374,12 @@ isLocalGRE other = False
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 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
......@@ -414,40 +415,52 @@ plusGRE g1 g2
%************************************************************************
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
| Imported -- Imported
| Imported -- Imported
[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_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
-- 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
......@@ -455,7 +468,10 @@ data ImportSpec -- Describes a particular import declaration
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
......@@ -465,9 +481,12 @@ instance Ord Provenance where
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`
(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
\end{code}
\begin{code}
......@@ -495,7 +514,7 @@ ppr_defn loc | isGoodSrcLoc loc = parens (ptext SLIT("defined at") <+> ppr loc)
| 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)
\end{code}
......@@ -11,7 +11,7 @@ module Desugar ( deSugar, deSugarExpr ) where
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(..) )
......@@ -29,7 +29,6 @@ import DsForeign ( dsForeigns )
import DsExpr () -- Forces DsExpr to be compiled; DsBinds only
-- depends on DsExpr.hi-boot.
import Module ( Module, moduleEnvElts, delModuleEnv, moduleFS )
import Id ( Id )
import RdrName ( GlobalRdrEnv )
import NameSet
import VarEnv
......
......@@ -26,7 +26,6 @@ import Maybes ( maybeToBool )
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,
......
......@@ -33,7 +33,7 @@ import TcHsSyn ( hsPatType )
-- 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
......@@ -44,7 +44,6 @@ import Id ( Id, idType, idName, idDataCon )
import PrelInfo ( rEC_CON_ERROR_ID, iRREFUT_PAT_ERROR_ID )
import DataCon ( DataCon, dataConWrapId, dataConFieldLabels, dataConInstOrigArgTys )
import DataCon ( isVanillaDataCon )
import Name ( Name )
import TyCon ( FieldLabel, tyConDataCons )
import TysWiredIn ( tupleCon )
import BasicTypes ( RecFlag(..), Boxity(..), ipNameName )
......@@ -53,7 +52,6 @@ import PrelNames ( toPName,
mfixName )
import SrcLoc ( Located(..), unLoc, getLoc, noLoc )
import Util ( zipEqual, zipWithEqual )
import Maybe ( fromJust )
import Bag ( bagToList )
import Outputable
import FastString
......
......@@ -41,7 +41,6 @@ import HscTypes ( TyThing(..), TypeEnv, HscEnv,
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 )
......
......@@ -28,7 +28,7 @@ import MkId ( mkDataConIds, mkRecordSelId, mkDictSelId )
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 )
......
......@@ -187,7 +187,7 @@ import BasicTypes ( Version, initialVersion, bumpVersion )
import TcRnMonad
import TcRnTypes ( mkModDeps )
import HscTypes ( ModIface(..), ModDetails(..),
ModGuts(..), ModGuts, IfaceExport,
ModGuts(..), IfaceExport,
HscEnv(..), hscEPS, Dependencies(..), FixItem(..),
ModSummary(..), msHiFilePath,
mkIfaceDepCache, mkIfaceFixCache, mkIfaceVerCache,
......
......@@ -42,7 +42,6 @@ import ErrUtils
import DynFlags
import StaticFlags ( v_Ld_inputs, opt_Static, WayName(..) )
import Config
import RdrName ( GlobalRdrEnv )
import Panic
import Util
import StringBuffer ( hGetStringBuffer )
......
......@@ -138,10 +138,10 @@ module GHC (
#ifdef GHCI
import qualified Linker
import Linker ( HValue, extendLinkEnv )
import NameEnv ( lookupNameEnv )
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 )
......@@ -149,14 +149,12 @@ import Type ( tidyType )
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 )
import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName, gre_name,
import RdrName ( GlobalRdrEnv, GlobalRdrElt(..), RdrName,
globalRdrEnvElts )
import HsSyn
import Type ( Kind, Type, dropForAlls )
......@@ -194,16 +192,15 @@ import StringBuffer ( StringBuffer, hGetStringBuffer )
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 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 Monad ( unless, when, foldM )
import Monad ( unless, when )
import System ( exitWith, ExitCode(..) )
import Time ( ClockTime )
import EXCEPTION as Exception hiding (handle)
......@@ -1745,9 +1742,11 @@ nameSetToGlobalRdrEnv names mod =
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 =
......
......@@ -21,7 +21,6 @@ module HscMain (
#ifdef GHCI
import HsSyn ( Stmt(..), LHsExpr, LStmt, LHsType )
import IfaceSyn ( IfaceDecl, IfaceInst )
import Module ( Module )
import CodeOutput ( outputForeignStubs )
import ByteCodeGen ( byteCodeGen, coreExprToBCOs )
......@@ -30,15 +29,12 @@ import CoreTidy ( tidyExpr )
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 BasicTypes ( Fixity )
import SrcLoc ( SrcLoc, noSrcLoc )
import SrcLoc ( noSrcLoc )
import VarEnv ( emptyTidyEnv )
#endif
......@@ -72,7 +68,6 @@ import CmmParse ( parseCmmFile )
import CodeOutput ( codeOutput )
import DynFlags
import DriverPhases ( HscSource(..) )
import ErrUtils
import UniqSupply ( mkSplitUniqSupply )
......
......@@ -50,7 +50,7 @@ module RdrHsSyn (
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 )
......
......@@ -75,7 +75,6 @@ import Type ( Type, mkTyConTy, mkTyConApp, mkTyVarTy, mkTyVarTys, TyThing(..) )
import Kind ( mkArrowKinds, liftedTypeKind, ubxTupleKind )
import Unique ( incrUnique, mkTupleTyConUnique,
mkTupleDataConUnique, mkPArrDataConUnique )
import PrelNames
import Array
import FastString
import Outputable
......
......@@ -42,7 +42,8 @@ import RdrName ( RdrName, rdrNameModule, isQual, isUnqual, isOrig,
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
......@@ -751,7 +752,7 @@ warnUnusedName (name, prov)
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)
......
......@@ -45,8 +45,8 @@ import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace,
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,
......@@ -180,8 +180,8 @@ importsFromImportDecl this_mod
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 ->
......@@ -378,7 +378,7 @@ available, and filters it through the import spec (if any).
\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)
......@@ -387,14 +387,16 @@ filterImports :: ModIface
-- 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 ]
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
......@@ -407,7 +409,7 @@ filterImports iface imp_spec (Just (want_hiding, import_items)) all_names
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
......@@ -419,7 +421,7 @@ filterImports iface imp_spec (Just (want_hiding, import_items)) 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]
......@@ -428,10 +430,11 @@ filterImports iface imp_spec (Just (want_hiding, import_items)) all_names
; 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] }
where
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.
......@@ -678,7 +681,7 @@ reportDeprecations tcg_env
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),
......@@ -686,7 +689,7 @@ reportDeprecations tcg_env
(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
......@@ -767,8 +770,8 @@ reportUnusedNames export_decls gbl_env
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
......@@ -801,7 +804,7 @@ reportUnusedNames export_decls gbl_env
-- 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
......@@ -887,13 +890,14 @@ warnDuplicateImports gres
, 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
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
red_decl = is_decl red_imp
redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
-- The returned pair is (redundant-import, covering-import)
......@@ -904,26 +908,40 @@ warnDuplicateImports gres
-- "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
| 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
| 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
| 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
= 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
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
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
......@@ -983,8 +1001,8 @@ printMinimalImports imps
%************************************************************************
\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)")
......
......@@ -30,7 +30,6 @@ import SimplEnv ( SimplEnv, simplBinders, mkSimplEnv, setInScopeSet )
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,
......
......@@ -58,10 +58,10 @@ import TcMType ( zonkTcType, zonkTcTypes, zonkTcPredType, zonkTcThetaType,
)
import TcType ( Type, TcType, TcThetaType, TcTyVarSet, TcTyVar, TcPredType,
PredType(..), SkolemInfo(..), typeKind, mkSigmaTy,
tcSplitForAllTys, tcSplitForAllTys, mkFunTy,
tcSplitForAllTys, mkFunTy,
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,
......
......@@ -21,7 +21,6 @@ module TcSimplify (
#include "HsVersions.h"
import {-# SOURCE #-} TcUnify( unifyTauTy )
import TcEnv -- temp
import HsSyn ( HsBind(..), HsExpr(..), LHsExpr, emptyLHsBinds )
import TcHsSyn ( TcId, TcDictBinds, mkHsApp, mkHsTyApp, mkHsDictApp )
......@@ -39,7 +38,8 @@ import Inst ( lookupInst, LookupInstResult(..),
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,
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment