From 4a5870490196e05c40a9362ac2fef0081567bffc Mon Sep 17 00:00:00 2001 From: simonpj Date: Thu, 19 May 2005 11:15:44 +0000 Subject: [PATCH] [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. --- ghc/compiler/basicTypes/RdrName.lhs | 77 ++++++++++++++++++----------- ghc/compiler/deSugar/Desugar.lhs | 3 +- ghc/compiler/deSugar/DsCCall.lhs | 1 - ghc/compiler/deSugar/DsExpr.lhs | 4 +- ghc/compiler/deSugar/DsMonad.lhs | 1 - ghc/compiler/iface/BuildTyCl.lhs | 2 +- ghc/compiler/iface/MkIface.lhs | 2 +- ghc/compiler/main/DriverPipeline.hs | 1 - ghc/compiler/main/GHC.hs | 25 +++++----- ghc/compiler/main/HscMain.lhs | 7 +-- ghc/compiler/parser/RdrHsSyn.lhs | 2 +- ghc/compiler/prelude/TysWiredIn.lhs | 1 - ghc/compiler/rename/RnEnv.lhs | 5 +- ghc/compiler/rename/RnNames.lhs | 86 ++++++++++++++++++++------------- ghc/compiler/simplCore/SimplCore.lhs | 1 - ghc/compiler/typecheck/Inst.lhs | 4 +- ghc/compiler/typecheck/TcSimplify.lhs | 4 +- 17 files changed, 125 insertions(+), 101 deletions(-) diff --git a/ghc/compiler/basicTypes/RdrName.lhs b/ghc/compiler/basicTypes/RdrName.lhs index 9d2e416..8903b8a 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 2c7ddd2..b70f802 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 576c721..ece24b2 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 fe7d1e3..6dc8f22 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 552526b..2dbe8b1 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 44a8a76..9383ae3 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 e508a17..f27538d 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 c63b1a7..125533b 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 36558f4..43f271d 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 4e826e1..ab14e17 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 1977a54..b49c869 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 6fa1daf..e7dea60 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 2fb2549..bdaa9f1 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 6eaf8f4..71073a2 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 03486c7..97cc14c 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 8e8e44a..3de9fb9 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 57906ad..579ad3e 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, -- 1.7.10.4