summaryrefslogtreecommitdiff
path: root/ghc
diff options
context:
space:
mode:
Diffstat (limited to 'ghc')
-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,
View Lorry Controller Status