summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorsimonpj <unknown>2005-05-19 11:15:44 +0000
committersimonpj <unknown>2005-05-19 11:15:44 +0000
commit4a5870490196e05c40a9362ac2fef0081567bffc (patch)
treecc37e04dc4452a45bf2c947f2c1fbf1afad4f42e
parentf01b31dd2e962b5d2ffcad547b3c781d41ec186b (diff)
downloadhaskell-4a5870490196e05c40a9362ac2fef0081567bffc.tar.gz
[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.
-rw-r--r--ghc/compiler/basicTypes/RdrName.lhs77
-rw-r--r--ghc/compiler/deSugar/Desugar.lhs3
-rw-r--r--ghc/compiler/deSugar/DsCCall.lhs1
-rw-r--r--ghc/compiler/deSugar/DsExpr.lhs4
-rw-r--r--ghc/compiler/deSugar/DsMonad.lhs1
-rw-r--r--ghc/compiler/iface/BuildTyCl.lhs2
-rw-r--r--ghc/compiler/iface/MkIface.lhs2
-rw-r--r--ghc/compiler/main/DriverPipeline.hs1
-rw-r--r--ghc/compiler/main/GHC.hs25
-rw-r--r--ghc/compiler/main/HscMain.lhs7
-rw-r--r--ghc/compiler/parser/RdrHsSyn.lhs2
-rw-r--r--ghc/compiler/prelude/TysWiredIn.lhs1
-rw-r--r--ghc/compiler/rename/RnEnv.lhs5
-rw-r--r--ghc/compiler/rename/RnNames.lhs86
-rw-r--r--ghc/compiler/simplCore/SimplCore.lhs1
-rw-r--r--ghc/compiler/typecheck/Inst.lhs4
-rw-r--r--ghc/compiler/typecheck/TcSimplify.lhs4
17 files changed, 125 insertions, 101 deletions
diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs
index 9d2e416d14..8903b8a412 100644
--- a/ghc/compiler/basicTypes/RdrName.lhs
+++ b/ghc/compiler/basicTypes/RdrName.lhs
@@ -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}
diff --git a/ghc/compiler/deSugar/Desugar.lhs b/ghc/compiler/deSugar/Desugar.lhs
index 2c7ddd2053..b70f8020d8 100644
--- a/ghc/compiler/deSugar/Desugar.lhs
+++ b/ghc/compiler/deSugar/Desugar.lhs
@@ -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
diff --git a/ghc/compiler/deSugar/DsCCall.lhs b/ghc/compiler/deSugar/DsCCall.lhs
index 576c721608..ece24b2354 100644
--- a/ghc/compiler/deSugar/DsCCall.lhs
+++ b/ghc/compiler/deSugar/DsCCall.lhs
@@ -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,
diff --git a/ghc/compiler/deSugar/DsExpr.lhs b/ghc/compiler/deSugar/DsExpr.lhs
index fe7d1e317c..6dc8f22d22 100644
--- a/ghc/compiler/deSugar/DsExpr.lhs
+++ b/ghc/compiler/deSugar/DsExpr.lhs
@@ -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
diff --git a/ghc/compiler/deSugar/DsMonad.lhs b/ghc/compiler/deSugar/DsMonad.lhs
index 552526bec3..2dbe8b1598 100644
--- a/ghc/compiler/deSugar/DsMonad.lhs
+++ b/ghc/compiler/deSugar/DsMonad.lhs
@@ -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 )
diff --git a/ghc/compiler/iface/BuildTyCl.lhs b/ghc/compiler/iface/BuildTyCl.lhs
index 44a8a76af2..9383ae3c3c 100644
--- a/ghc/compiler/iface/BuildTyCl.lhs
+++ b/ghc/compiler/iface/BuildTyCl.lhs
@@ -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 )
diff --git a/ghc/compiler/iface/MkIface.lhs b/ghc/compiler/iface/MkIface.lhs
index e508a176f1..f27538d4df 100644
--- a/ghc/compiler/iface/MkIface.lhs
+++ b/ghc/compiler/iface/MkIface.lhs
@@ -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,
diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs
index c63b1a777a..125533b8a4 100644
--- a/ghc/compiler/main/DriverPipeline.hs
+++ b/ghc/compiler/main/DriverPipeline.hs
@@ -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 )
diff --git a/ghc/compiler/main/GHC.hs b/ghc/compiler/main/GHC.hs
index 36558f4e3c..43f271d459 100644
--- a/ghc/compiler/main/GHC.hs
+++ b/ghc/compiler/main/GHC.hs
@@ -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 =
diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs
index 4e826e16a8..ab14e17d94 100644
--- a/ghc/compiler/main/HscMain.lhs
+++ b/ghc/compiler/main/HscMain.lhs
@@ -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 )
diff --git a/ghc/compiler/parser/RdrHsSyn.lhs b/ghc/compiler/parser/RdrHsSyn.lhs
index 1977a5430b..b49c869bc9 100644
--- a/ghc/compiler/parser/RdrHsSyn.lhs
+++ b/ghc/compiler/parser/RdrHsSyn.lhs
@@ -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 )
diff --git a/ghc/compiler/prelude/TysWiredIn.lhs b/ghc/compiler/prelude/TysWiredIn.lhs
index 6fa1dafc94..e7dea60711 100644
--- a/ghc/compiler/prelude/TysWiredIn.lhs
+++ b/ghc/compiler/prelude/TysWiredIn.lhs
@@ -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
diff --git a/ghc/compiler/rename/RnEnv.lhs b/ghc/compiler/rename/RnEnv.lhs
index 2fb2549cfc..bdaa9f156e 100644
--- a/ghc/compiler/rename/RnEnv.lhs
+++ b/ghc/compiler/rename/RnEnv.lhs
@@ -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)
diff --git a/ghc/compiler/rename/RnNames.lhs b/ghc/compiler/rename/RnNames.lhs
index 6eaf8f41f2..71073a2e6c 100644
--- a/ghc/compiler/rename/RnNames.lhs
+++ b/ghc/compiler/rename/RnNames.lhs
@@ -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)")
diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index 03486c7662..97cc14cfec 100644
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -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,
diff --git a/ghc/compiler/typecheck/Inst.lhs b/ghc/compiler/typecheck/Inst.lhs
index 8e8e44ae2f..3de9fb97bb 100644
--- a/ghc/compiler/typecheck/Inst.lhs
+++ b/ghc/compiler/typecheck/Inst.lhs
@@ -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,
diff --git a/ghc/compiler/typecheck/TcSimplify.lhs b/ghc/compiler/typecheck/TcSimplify.lhs
index 57906add6f..579ad3eecd 100644
--- a/ghc/compiler/typecheck/TcSimplify.lhs
+++ b/ghc/compiler/typecheck/TcSimplify.lhs
@@ -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,