diff options
author | Simon Peyton Jones <simonpj@microsoft.com> | 2015-10-30 09:41:47 +0000 |
---|---|---|
committer | Simon Peyton Jones <simonpj@microsoft.com> | 2015-10-30 09:45:49 +0000 |
commit | 3e94842d4d1258fbd6a1202bf74d41ce1d01c753 (patch) | |
tree | 703ec106f907a72be0d4349a31ca33c44651ee48 | |
parent | 9376249b6b78610db055a10d05f6592d6bbbea2f (diff) | |
download | haskell-3e94842d4d1258fbd6a1202bf74d41ce1d01c753.tar.gz |
Record usage information using GlobalRdrElt
This patch implements an improvment that I've wanted to do for ages, but
never gotten around to.
Unused imports are computed based on how imported entities occur (qualified,
unqualified). This info was accumulated in tcg_used_rdrnames :: Set RdrName.
But that was a huge pain, and it got worse when we introduced duplicate
record fields.
The Right Thing is to record tcg_used_gres :: [GlobalRdrElt], which records
the GRE *after* filtering with pickGREs. See Note [GRE filtering] in RdrName.
This is much, much bette. This patch deletes quite a bit of code, and is
conceptually much easier to follow.
Hooray. There should be no change in functionality.
-rw-r--r-- | compiler/basicTypes/RdrName.hs | 140 | ||||
-rw-r--r-- | compiler/rename/RnEnv.hs | 88 | ||||
-rw-r--r-- | compiler/rename/RnNames.hs | 102 | ||||
-rw-r--r-- | compiler/rename/RnPat.hs | 2 | ||||
-rw-r--r-- | compiler/typecheck/TcCanonical.hs | 12 | ||||
-rw-r--r-- | compiler/typecheck/TcDeriv.hs | 9 | ||||
-rw-r--r-- | compiler/typecheck/TcExpr.hs | 5 | ||||
-rw-r--r-- | compiler/typecheck/TcRnDriver.hs | 14 | ||||
-rw-r--r-- | compiler/typecheck/TcRnMonad.hs | 7 | ||||
-rw-r--r-- | compiler/typecheck/TcRnTypes.hs | 34 | ||||
-rw-r--r-- | compiler/typecheck/TcSMonad.hs | 10 | ||||
-rw-r--r-- | testsuite/tests/module/Mod136_A.hs | 4 | ||||
-rw-r--r-- | testsuite/tests/module/mod136.hs | 3 | ||||
-rw-r--r-- | testsuite/tests/module/mod136.stderr | 12 | ||||
-rw-r--r-- | testsuite/tests/rename/should_compile/T4239.stdout | 2 |
15 files changed, 189 insertions, 255 deletions
diff --git a/compiler/basicTypes/RdrName.hs b/compiler/basicTypes/RdrName.hs index 2f10455e80..8af8df4000 100644 --- a/compiler/basicTypes/RdrName.hs +++ b/compiler/basicTypes/RdrName.hs @@ -47,7 +47,7 @@ module RdrName ( lookupGlobalRdrEnv, extendGlobalRdrEnv, greOccName, shadowNames, pprGlobalRdrEnv, globalRdrEnvElts, lookupGRE_RdrName, lookupGRE_Name, lookupGRE_Field_Name, getGRE_NameQualifier_maybes, - transformGREs, pickGREs, + transformGREs, pickGREs, pickGREsModExp, -- * GlobalRdrElts gresFromAvails, gresFromAvail, localGREsFromAvail, availFromGRE, @@ -633,15 +633,13 @@ mkParent n (AvailTC m _ _) | n == m = NoParent | otherwise = ParentIs m availFromGRE :: GlobalRdrElt -> AvailInfo -availFromGRE gre - = case gre_par gre of +availFromGRE (GRE { gre_name = me, gre_par = parent }) + = case parent of ParentIs p -> AvailTC p [me] [] NoParent | isTyConName me -> AvailTC me [me] [] | otherwise -> Avail me FldParent p Nothing -> AvailTC p [] [FieldLabel (occNameFS $ nameOccName me) False me] FldParent p (Just lbl) -> AvailTC p [] [FieldLabel lbl True me] - where - me = gre_name gre emptyGlobalRdrEnv :: GlobalRdrEnv emptyGlobalRdrEnv = emptyOccEnv @@ -728,57 +726,95 @@ unQualOK (GRE {gre_lcl = lcl, gre_imp = iss }) | lcl = True | otherwise = any unQualSpecOK iss +{- Note [GRE filtering] +~~~~~~~~~~~~~~~~~~~~~~~ +(pickGREs rdr gres) takes a list of GREs which have the same OccName +as 'rdr', say "x". It does two things: + +(a) filters the GREs to a subset that are in scope + * Qualified, as 'M.x' if want_qual is Qual M _ + * Unqualified, as 'x' if want_unqual is Unqual _ + +(b) for that subset, filter the provenance field (gre_lcl and gre_imp) + to ones that brought it into scope qualifed or unqualified resp. + +Example: + module A ( f ) where + import qualified Foo( f ) + import Baz( f ) + f = undefined + +Let's suppose that Foo.f and Baz.f are the same entity really, but the local +'f' is different, so there will be two GREs matching "f": + gre1: gre_lcl = True, gre_imp = [] + gre2: gre_lcl = False, gre_imp = [ imported from Foo, imported from Bar ] + +The use of "f" in the export list is ambiguous because it's in scope +from the local def and the import Baz(f); but *not* the import qualified Foo. +pickGREs returns two GRE + gre1: gre_lcl = True, gre_imp = [] + gre2: gre_lcl = False, gre_imp = [ imported from Bar ] + +Now the the "ambiguous occurrence" message can correctly report how the +ambiguity arises. +-} + pickGREs :: RdrName -> [GlobalRdrElt] -> [GlobalRdrElt] --- ^ Take a list of GREs which have the right OccName --- Pick those GREs that are suitable for this RdrName --- And for those, keep only only the Provenances that are suitable --- Only used for Qual and Unqual, not Orig or Exact --- --- Consider: --- --- @ --- module A ( f ) where --- import qualified Foo( f ) --- import Baz( f ) --- f = undefined --- @ +-- ^ Takes a list of GREs which have the right OccName 'x' +-- Pick those GREs that are are in scope +-- * Qualified, as 'M.x' if want_qual is Qual M _ +-- * Unqualified, as 'x' if want_unqual is Unqual _ -- --- Let's suppose that @Foo.f@ and @Baz.f@ are the same entity really. --- The export of @f@ is ambiguous because it's in scope from the local def --- and the import. The lookup of @Unqual f@ should return a GRE for --- the locally-defined @f@, and a GRE for the imported @f@, with a /single/ --- provenance, namely the one for @Baz(f)@, so that the "ambiguous occurrence" --- message mentions the correct candidates -pickGREs rdr_name gres - = ASSERT2( isSrcRdrName rdr_name, ppr rdr_name ) - mapMaybe pick gres +-- Return each such GRE, with its ImportSpecs filtered, to reflect +-- how it is in scope qualifed or unqualified respectively. +-- See Note [GRE filtering] +pickGREs (Unqual {}) gres = mapMaybe pickUnqualGRE gres +pickGREs (Qual mod _) gres = mapMaybe (pickQualGRE mod) gres +pickGREs _ _ = [] -- I don't think this actually happens + +pickUnqualGRE :: GlobalRdrElt -> Maybe GlobalRdrElt +pickUnqualGRE gre@(GRE { gre_lcl = lcl, gre_imp = iss }) + | not lcl, null iss' = Nothing + | otherwise = Just (gre { gre_imp = iss' }) where - rdr_is_unqual = isUnqual rdr_name - rdr_is_qual = isQual_maybe rdr_name + iss' = filter unQualSpecOK iss - pick :: GlobalRdrElt -> Maybe GlobalRdrElt - pick gre@(GRE { gre_name = n, gre_lcl = lcl, gre_imp = iss }) - | not lcl' && null iss' - = Nothing - - | otherwise - = Just (gre { gre_lcl = lcl', gre_imp = iss' }) - - where - lcl' | not lcl = False - | rdr_is_unqual = True - | Just (mod,_) <- rdr_is_qual -- Qualified name - , Just n_mod <- nameModule_maybe n -- Binder is External - = mod == moduleName n_mod - | otherwise - = False - - iss' | rdr_is_unqual - = filter (not . is_qual . is_decl) iss - | Just (mod,_) <- rdr_is_qual - = filter ((== mod) . is_as . is_decl) iss - | otherwise - = [] +pickQualGRE :: ModuleName -> GlobalRdrElt -> Maybe GlobalRdrElt +pickQualGRE mod gre@(GRE { gre_name = n, gre_lcl = lcl, gre_imp = iss }) + | not lcl', null iss' = Nothing + | otherwise = Just (gre { gre_lcl = lcl', gre_imp = iss' }) + where + iss' = filter (qualSpecOK mod) iss + lcl' = lcl && name_is_from mod n + + name_is_from :: ModuleName -> Name -> Bool + name_is_from mod name = case nameModule_maybe name of + Just n_mod -> moduleName n_mod == mod + Nothing -> False + +pickGREsModExp :: ModuleName -> [GlobalRdrElt] -> [(GlobalRdrElt,GlobalRdrElt)] +-- ^ Pick GREs that are in scope *both* qualified *and* unqualified +-- Return each GRE that is, as a pair +-- (qual_gre, unqual_gre) +-- These two GREs are the original GRE with imports filtered to express how +-- it is in scope qualified an unqualified respectively +-- +-- Used only for the 'module M' item in export list; +-- see RnNames.exports_from_avail +pickGREsModExp mod gres = mapMaybe (pickBothGRE mod) gres + +pickBothGRE :: ModuleName -> GlobalRdrElt -> Maybe (GlobalRdrElt, GlobalRdrElt) +pickBothGRE mod gre@(GRE { gre_name = n }) + | isBuiltInSyntax n = Nothing + | Just gre1 <- pickQualGRE mod gre + , Just gre2 <- pickUnqualGRE gre = Just (gre1, gre2) + | otherwise = Nothing + where + -- isBuiltInSyntax filter out names for built-in syntax They + -- just clutter up the environment (esp tuples), and the + -- parser will generate Exact RdrNames for them, so the + -- cluttered envt is no use. Really, it's only useful for + -- GHC.Base and GHC.Tuple. -- Building GlobalRdrEnvs diff --git a/compiler/rename/RnEnv.hs b/compiler/rename/RnEnv.hs index 79f0c0826e..1ed55ba64b 100644 --- a/compiler/rename/RnEnv.hs +++ b/compiler/rename/RnEnv.hs @@ -25,8 +25,8 @@ module RnEnv ( lookupSubBndrGREs, lookupConstructorFields, lookupSyntaxName, lookupSyntaxNames, lookupIfThenElse, lookupGreAvailRn, - getLookupOccRn, addUsedRdrNames, - addUsedRdrName, + getLookupOccRn, + addUsedGRE, addUsedGREs, addUsedDataCons, newLocalBndrRn, newLocalBndrsRn, bindLocalNames, bindLocalNamesFV, @@ -76,7 +76,6 @@ import DynFlags import FastString import Control.Monad import Data.List -import qualified Data.Set as Set import ListSetOps ( minusList ) import Constants ( mAX_TUPLE_SIZE ) @@ -141,7 +140,7 @@ One might conceivably want to report deprecation warnings when compiling ASig with -sig-of B, in which case we need to look at B.hi to find the deprecation warnings during renaming. At the moment, you don't get any warning until you use the identifier further downstream. This would -require adjusting addUsedRdrName so that during signature compilation, +require adjusting addUsedGRE so that during signature compilation, we do not report deprecation warnings for LocalDef. See also Note [Handling of deprecations] -} @@ -213,7 +212,7 @@ newTopSrcBinder (L loc rdr_name) -- information later [GRE{ gre_name = n }] -> do -- NB: Just adding this line will not work: - -- addUsedRdrName True gre rdr_name + -- addUsedGRE True gre -- see Note [Signature lazy interface loading] for -- more details. return (setNameLoc n loc) @@ -480,8 +479,9 @@ lookupSubBndrOcc warnIfDeprec parent doc rdr_name -- NB: lookupGlobalRdrEnv, not lookupGRE_RdrName! -- The latter does pickGREs, but we want to allow 'x' -- even if only 'M.x' is in scope - [gre] -> do { addUsedRdrName warnIfDeprec gre (used_rdr_name gre) + [gre] -> do { addUsedGRE warnIfDeprec gre -- Add a usage; this is an *occurrence* site + -- Note [Usage for sub-bndrs] ; return (gre_name gre) } [] -> do { ns <- lookupQualifiedNameGHCi rdr_name ; case ns of { @@ -492,11 +492,6 @@ lookupSubBndrOcc warnIfDeprec parent doc rdr_name ; return (mkUnboundName rdr_name) } } } gres -> do { addNameClashErrRn rdr_name gres ; return (gre_name (head gres)) } } - where - -- Note [Usage for sub-bndrs] - used_rdr_name gre - | isQual rdr_name = rdr_name - | otherwise = greUsedRdrName gre lookupSubBndrGREs :: GlobalRdrEnv -> Maybe Name -> RdrName -> [GlobalRdrElt] -- If parent = Nothing, just do a normal lookup @@ -865,11 +860,11 @@ lookupGlobalOccRn_overloaded overload_ok rdr_name ; case lookupGRE_RdrName rdr_name env of [] -> return Nothing [gre] | isRecFldGRE gre - -> do { addUsedRdrName True gre rdr_name + -> do { addUsedGRE True gre ; let fld_occ = FieldOcc rdr_name (gre_name gre) ; return (Just (Right [fld_occ])) } | otherwise - -> do { addUsedRdrName True gre rdr_name + -> do { addUsedGRE True gre ; return (Just (Left (gre_name gre))) } gres | all isRecFldGRE gres && overload_ok -- Don't record usage for ambiguous selectors @@ -894,7 +889,7 @@ lookupGreRn_maybe rdr_name = do { env <- getGlobalRdrEnv ; case lookupGRE_RdrName rdr_name env of [] -> return Nothing - [gre] -> do { addUsedRdrName True gre rdr_name + [gre] -> do { addUsedGRE True gre ; return (Just gre) } gres -> do { addNameClashErrRn rdr_name gres ; traceRn (text "name clash" <+> (ppr rdr_name $$ ppr gres $$ ppr env)) @@ -910,7 +905,7 @@ lookupGreRn2_maybe rdr_name ; case lookupGRE_RdrName rdr_name env of [] -> do { _ <- unboundName WL_Global rdr_name ; return Nothing } - [gre] -> do { addUsedRdrName True gre rdr_name + [gre] -> do { addUsedGRE True gre ; return (Just gre) } gres -> do { addNameClashErrRn rdr_name gres ; traceRn (text "name clash" <+> (ppr rdr_name $$ ppr gres $$ ppr env)) @@ -946,47 +941,40 @@ Note [Handling of deprecations] even use a deprecated thing in the defn of a non-deprecated thing, when changing a module's interface. -* addUsedRdrNames: we do not report deprecations for sub-binders: +* addUsedGREs: we do not report deprecations for sub-binders: - the ".." completion for records - the ".." in an export item 'T(..)' - the things exported by a module export 'module M' -} -addUsedRdrName :: Bool -> GlobalRdrElt -> RdrName -> RnM () --- Record usage of imported RdrNames -addUsedRdrName warn_if_deprec gre rdr - = do { if isRecFldGRE gre - then addUsedSelector (FieldOcc rdr (gre_name gre)) - else unless (isLocalGRE gre) $ addOneUsedRdrName rdr - - ; when warn_if_deprec $ - warnIfDeprecated gre } - -addUsedSelector :: FieldOcc Name -> RnM () --- Record usage of record selectors by DuplicateRecordFields -addUsedSelector n - = do { env <- getGblEnv - ; traceRn (text "addUsedSelector " <+> ppr n) - ; updMutVar (tcg_used_selectors env) - (\s -> Set.insert n s) } - -addOneUsedRdrName :: RdrName -> RnM () -addOneUsedRdrName rdr - = do { env <- getGblEnv - ; traceRn (text "addUsedRdrName 1" <+> ppr rdr) - ; updMutVar (tcg_used_rdrnames env) - (\s -> Set.insert rdr s) } - -addUsedRdrNames :: [RdrName] -> RnM () --- Record used sub-binders --- We don't check for imported-ness here, because it's inconvenient --- and not stritly necessary. +addUsedDataCons :: GlobalRdrEnv -> TyCon -> RnM () +-- Remember use of in-scope data constructors (Trac #7969) +addUsedDataCons rdr_env tycon + = addUsedGREs [ gre + | dc <- tyConDataCons tycon + , gre : _ <- [lookupGRE_Name rdr_env (dataConName dc) ] ] + +addUsedGRE :: Bool -> GlobalRdrElt -> RnM () +-- Called for both local and imported things +-- Add usage *and* warn if deprecated +addUsedGRE warn_if_deprec gre + = do { when warn_if_deprec (warnIfDeprecated gre) + ; unless (isLocalGRE gre) $ + do { env <- getGblEnv + ; traceRn (text "addUsedGRE" <+> ppr gre) + ; updMutVar (tcg_used_gres env) (gre :) } } + +addUsedGREs :: [GlobalRdrElt] -> RnM () +-- Record uses of any *imported* GREs +-- Used for recording used sub-bndrs -- NB: no call to warnIfDeprecated; see Note [Handling of deprecations] -addUsedRdrNames rdrs - = do { env <- getGblEnv - ; traceRn (text "addUsedRdrName 2" <+> ppr rdrs) - ; updMutVar (tcg_used_rdrnames env) - (\s -> foldr Set.insert s rdrs) } +addUsedGREs gres + | null imp_gres = return () + | otherwise = do { env <- getGblEnv + ; traceRn (text "addUsedGREs" <+> ppr imp_gres) + ; updMutVar (tcg_used_gres env) (imp_gres ++) } + where + imp_gres = filterOut isLocalGRE gres warnIfDeprecated :: GlobalRdrElt -> RnM () warnIfDeprecated gre@(GRE { gre_name = name, gre_imp = iss }) diff --git a/compiler/rename/RnNames.hs b/compiler/rename/RnNames.hs index e0b06839e5..d542a880d3 100644 --- a/compiler/rename/RnNames.hs +++ b/compiler/rename/RnNames.hs @@ -46,12 +46,12 @@ import ListSetOps import Control.Monad import Data.Either ( partitionEithers, isRight, rights ) -import qualified Data.Foldable as Foldable +-- import qualified Data.Foldable as Foldable import Data.Map ( Map ) import qualified Data.Map as Map import Data.Ord ( comparing ) import Data.List ( partition, (\\), find, sortBy ) -import qualified Data.Set as Set +-- import qualified Data.Set as Set import System.FilePath ((</>)) import System.IO @@ -1216,23 +1216,21 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod return acc } | otherwise - = do { implicit_prelude <- xoptM Opt_ImplicitPrelude - ; warnDodgyExports <- woptM Opt_WarnDodgyExports + = do { warnDodgyExports <- woptM Opt_WarnDodgyExports ; let { exportValid = (mod `elem` imported_modules) || (moduleName this_mod == mod) - ; gres = filter (isModuleExported implicit_prelude mod) - (globalRdrEnvElts rdr_env) - ; new_exports = map availFromGRE gres - ; names = map gre_name gres } + ; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env) + ; new_exports = map (availFromGRE . fst) gre_prs + ; names = map (gre_name . fst) gre_prs + ; all_gres = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs + } ; checkErr exportValid (moduleNotImported mod) - ; warnIf (warnDodgyExports && exportValid && null names) + ; warnIf (warnDodgyExports && exportValid && null gre_prs) (nullModuleExport mod) - ; addUsedRdrNames (concat [ [mkRdrQual mod occ, mkRdrUnqual occ] - | occ <- map nameOccName names ]) - -- The qualified and unqualified version of all of - -- these names are, in effect, used by this export + ; traceRn (text "efa" <+> (ppr mod $$ ppr all_gres)) + ; addUsedGREs all_gres ; occs' <- check_occs (IEModuleContents (noLoc mod)) occs names -- This check_occs not only finds conflicts @@ -1314,12 +1312,9 @@ exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod -- In an export item M.T(A,B,C), we want to treat the uses of -- A,B,C as if they were M.A, M.B, M.C - addUsedKids parent_rdr kid_names - = addUsedRdrNames $ map (mk_kid_rdr . greOccName) kid_names - where - mk_kid_rdr = case isQual_maybe parent_rdr of - Nothing -> mkRdrUnqual - Just (modName, _) -> mkRdrQual modName + -- Happily pickGREs does just the right thing + addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM () + addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres) isDoc :: IE RdrName -> Bool isDoc (IEDoc _) = True @@ -1329,27 +1324,6 @@ isDoc _ = False ------------------------------- -isModuleExported :: Bool -> ModuleName -> GlobalRdrElt -> Bool --- True if the thing is in scope *both* unqualified, *and* with qualifier M -isModuleExported implicit_prelude mod - (GRE { gre_name = name, gre_lcl = lcl, gre_imp = iss }) - | implicit_prelude && isBuiltInSyntax name = False - -- Optimisation: filter out names for built-in syntax - -- They just clutter up the environment (esp tuples), and the parser - -- will generate Exact RdrNames for them, so the cluttered - -- envt is no use. To avoid doing this filter all the time, - -- we use -XNoImplicitPrelude as a clue that the filter is - -- worth while. Really, it's only useful for GHC.Base and GHC.Tuple. - -- - -- It's worth doing because it makes the environment smaller for - -- every module that imports the Prelude - | otherwise - = (lcl && (case nameModule_maybe name of - Just name_mod -> moduleName name_mod == mod - Nothing -> False)) - || (any unQualSpecOK iss && any (qualSpecOK mod) iss) - -------------------------------- check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap check_occs ie occs names -- 'names' are the entities specifed by 'ie' = foldlM check occs names @@ -1426,10 +1400,8 @@ reportUnusedNames :: Maybe (Located [LIE RdrName]) -- Export list -> TcGblEnv -> RnM () reportUnusedNames _export_decls gbl_env = do { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env))) - ; sel_uses <- readMutVar (tcg_used_selectors gbl_env) ; warnUnusedImportDecls gbl_env - ; warnUnusedTopBinds $ filterOut (used_as_selector sel_uses) - unused_locals } + ; warnUnusedTopBinds unused_locals } where used_names :: NameSet used_names = findUses (tcg_dus gbl_env) emptyNameSet @@ -1466,12 +1438,6 @@ reportUnusedNames _export_decls gbl_env is_unused_local :: GlobalRdrElt -> Bool is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre) - -- Remove uses of record selectors recorded in the typechecker - used_as_selector :: Set.Set (FieldOcc Name) -> GlobalRdrElt -> Bool - used_as_selector sel_uses gre - = isRecFldGRE gre && Foldable.any ((==) (gre_name gre) . selectorFieldOcc) sel_uses - - {- ********************************************************* * * @@ -1491,8 +1457,7 @@ type ImportDeclUsage warnUnusedImportDecls :: TcGblEnv -> RnM () warnUnusedImportDecls gbl_env - = do { uses <- fmap Set.elems $ readMutVar (tcg_used_rdrnames gbl_env) - ; sel_uses <- readMutVar (tcg_used_selectors gbl_env) + = do { uses <- readMutVar (tcg_used_gres gbl_env) ; let user_imports = filterOut (ideclImplicit . unLoc) (tcg_rn_imports gbl_env) -- This whole function deals only with *user* imports -- both for warning about unnecessary ones, and for @@ -1501,10 +1466,9 @@ warnUnusedImportDecls gbl_env fld_env = mkFieldEnv rdr_env ; let usage :: [ImportDeclUsage] - usage = findImportUsage user_imports rdr_env uses sel_uses + usage = findImportUsage user_imports uses ; traceRn (vcat [ ptext (sLit "Uses:") <+> ppr uses - , ptext (sLit "Selector uses:") <+> ppr sel_uses , ptext (sLit "Import usage") <+> ppr usage]) ; whenWOptM Opt_WarnUnusedImports $ mapM_ (warnUnusedImport fld_env) usage @@ -1537,19 +1501,15 @@ not normalised). type ImportMap = Map SrcLoc [AvailInfo] -- See [The ImportMap] findImportUsage :: [LImportDecl Name] - -> GlobalRdrEnv - -> [RdrName] - -> Set.Set (FieldOcc Name) + -> [GlobalRdrElt] -> [ImportDeclUsage] -findImportUsage imports rdr_env rdrs sel_names +findImportUsage imports used_gres = map unused_decl imports where import_usage :: ImportMap import_usage - = foldr (extendImportMap_Field rdr_env) - (foldr (extendImportMap rdr_env) Map.empty rdrs) - (Set.elems sel_names) + = foldr extendImportMap Map.empty used_gres unused_decl decl@(L loc (ImportDecl { ideclHiding = imps })) = (decl, nubAvails used_avails, nameSetElems unused_imps) @@ -1589,30 +1549,12 @@ findImportUsage imports rdr_env rdrs sel_names -- imported Num(signum). We don't want to complain that -- Num is not itself mentioned. Hence the two cases in add_unused_with. -extendImportMap :: GlobalRdrEnv - -> RdrName - -> ImportMap -> ImportMap -extendImportMap rdr_env rdr = - extendImportMap_GRE (lookupGRE_RdrName rdr rdr_env) - -extendImportMap_Field :: GlobalRdrEnv - -> FieldOcc Name - -> ImportMap -> ImportMap -extendImportMap_Field rdr_env (FieldOcc rdr sel) = - extendImportMap_GRE (pickGREs rdr (lookupGRE_Field_Name rdr_env sel lbl)) - where - lbl = occNameFS (rdrNameOcc rdr) - +extendImportMap :: GlobalRdrElt -> ImportMap -> ImportMap -- For each of a list of used GREs, find all the import decls that brought -- it into scope; choose one of them (bestImport), and record -- the RdrName in that import decl's entry in the ImportMap -extendImportMap_GRE :: [GlobalRdrElt] -> ImportMap -> ImportMap -extendImportMap_GRE gres imp_map - | (gre:_) <- gres - , not (isLocalGRE gre) -- Should always be true, because we only need record - -- uses of imported things, but that's not true yet +extendImportMap gre imp_map = add_imp gre (bestImport (gre_imp gre)) imp_map - | otherwise = imp_map where add_imp :: GlobalRdrElt -> ImportSpec -> ImportMap -> ImportMap add_imp gre (ImpSpec { is_decl = imp_decl_spec }) imp_map diff --git a/compiler/rename/RnPat.hs b/compiler/rename/RnPat.hs index 053d4addc9..6637156d2b 100644 --- a/compiler/rename/RnPat.hs +++ b/compiler/rename/RnPat.hs @@ -612,7 +612,7 @@ rnHsRecFields ctxt mk_arg (HsRecFields { rec_flds = flds, rec_dotdot = dotdot }) HsRecFieldCon {} -> arg_in_scope lbl _other -> True ] - ; addUsedRdrNames (map (\ (_, _, gre) -> greUsedRdrName gre) dot_dot_gres) + ; addUsedGREs (map thirdOf3 dot_dot_gres) ; return [ L loc (HsRecField { hsRecFieldLbl = L loc (FieldOcc arg_rdr sel) , hsRecFieldArg = L loc (mk_arg arg_rdr) diff --git a/compiler/typecheck/TcCanonical.hs b/compiler/typecheck/TcCanonical.hs index 4d92593f5d..693299ba25 100644 --- a/compiler/typecheck/TcCanonical.hs +++ b/compiler/typecheck/TcCanonical.hs @@ -29,7 +29,6 @@ import Outputable import DynFlags( DynFlags ) import VarSet import RdrName -import DataCon ( dataConName ) import Pair import Util @@ -599,7 +598,7 @@ can_eq_newtype_nc rdr_env ev swapped co ty1 ty1' ty2 ps_ty2 -- check for blowing our stack: -- See Note [Newtypes can blow the stack] ; checkReductionDepth (ctEvLoc ev) ty1 - ; markDataConsAsUsed rdr_env (tyConAppTyCon ty1) + ; addUsedDataCons rdr_env (tyConAppTyCon ty1) -- we have actually used the newtype constructor here, so -- make sure we don't warn about importing it! @@ -608,15 +607,6 @@ can_eq_newtype_nc rdr_env ev swapped co ty1 ty1' ty2 ps_ty2 `andWhenContinue` \ new_ev -> can_eq_nc False new_ev ReprEq ty1' ty1' ty2 ps_ty2 } --- | Mark all the datacons of the given 'TyCon' as used in this module, --- avoiding "redundant import" warnings. -markDataConsAsUsed :: GlobalRdrEnv -> TyCon -> TcS () -markDataConsAsUsed rdr_env tc = addUsedRdrNamesTcS - [ greUsedRdrName gre - | dc <- tyConDataCons tc - , gre : _ <- return $ lookupGRE_Name rdr_env (dataConName dc) - , not (isLocalGRE gre) ] - --------- -- ^ Decompose a type application. -- All input types must be flat. See Note [Canonicalising type applications] diff --git a/compiler/typecheck/TcDeriv.hs b/compiler/typecheck/TcDeriv.hs index 05d689a203..95d47887c7 100644 --- a/compiler/typecheck/TcDeriv.hs +++ b/compiler/typecheck/TcDeriv.hs @@ -809,14 +809,7 @@ mkEqnHelp overlap_mode tvs cls cls_tys tycon tc_args mtheta any not_in_scope data_con_names) not_in_scope dc = null (lookupGRE_Name rdr_env dc) - -- Make a Qual RdrName that will do for each DataCon - -- so we can report it as used (Trac #7969) - data_con_rdrs = [ greUsedRdrName gre - | dc_name <- data_con_names - , gre : _ <- [lookupGRE_Name rdr_env dc_name] - , not (isLocalGRE gre) ] - - ; addUsedRdrNames data_con_rdrs + ; addUsedDataCons rdr_env rep_tc ; unless (isNothing mtheta || not hidden_data_cons) (bale_out (derivingHiddenErr tycon)) diff --git a/compiler/typecheck/TcExpr.hs b/compiler/typecheck/TcExpr.hs index dd765ca41e..fe9e0cb5bd 100644 --- a/compiler/typecheck/TcExpr.hs +++ b/compiler/typecheck/TcExpr.hs @@ -28,7 +28,7 @@ import BasicTypes import Inst import TcBinds import FamInst ( tcGetFamInstEnvs, tcLookupDataFamInst ) -import RnEnv ( addUsedRdrName ) +import RnEnv ( addUsedGRE ) import TcEnv import TcArrows import TcMatches @@ -1546,8 +1546,7 @@ disambiguateRecordBinds record_expr rbnds res_ty -- be recorded again (giving duplicate deprecation warnings). f (fld, gre, was_unambiguous) = do { unless was_unambiguous $ do - let L loc rdr = hsRecUpdFieldRdr (unLoc fld) - setSrcSpan loc $ addUsedRdrName True gre rdr + setSrcSpan (getLoc fld) $ addUsedGRE True gre ; return (fld, gre_name gre) } -- Returns Right if fld can have parent p, or Left lbl if not. diff --git a/compiler/typecheck/TcRnDriver.hs b/compiler/typecheck/TcRnDriver.hs index 45c25e4942..ae3e5ffdd4 100644 --- a/compiler/typecheck/TcRnDriver.hs +++ b/compiler/typecheck/TcRnDriver.hs @@ -1178,8 +1178,6 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, ; fo_gres = fi_gres `unionBags` foe_gres ; fo_fvs = foldrBag (\gre fvs -> fvs `addOneFV` gre_name gre) emptyFVs fo_gres - ; fo_rdr_names :: [RdrName] - ; fo_rdr_names = foldrBag gre_to_rdr_name [] fo_gres ; sig_names = mkNameSet (collectHsValBinders val_binds) `minusNameSet` getTypeSigNames val_binds @@ -1197,17 +1195,11 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls, , tcg_dus = tcg_dus tcg_env `plusDU` usesOnly fo_fvs } } ; -- tcg_dus: see Note [Newtype constructor usage in foreign declarations] - addUsedRdrNames fo_rdr_names ; + -- See Note [Newtype constructor usage in foreign declarations] + addUsedGREs (bagToList fo_gres) ; + return (tcg_env', tcl_env) }}}}}} - where - gre_to_rdr_name :: GlobalRdrElt -> [RdrName] -> [RdrName] - -- For *imported* newtype data constructors, we want to - -- make sure that at least one of the imports for them is used - -- See Note [Newtype constructor usage in foreign declarations] - gre_to_rdr_name gre rdrs - | isLocalGRE gre = rdrs - | otherwise = greUsedRdrName gre : rdrs --------------------------- tcTyClsInstDecls :: [TyClGroup Name] diff --git a/compiler/typecheck/TcRnMonad.hs b/compiler/typecheck/TcRnMonad.hs index 601b030f74..27cd7c099a 100644 --- a/compiler/typecheck/TcRnMonad.hs +++ b/compiler/typecheck/TcRnMonad.hs @@ -53,7 +53,6 @@ import BasicTypes( TopLevelFlag ) import Control.Exception import Data.IORef -import qualified Data.Set as Set import Control.Monad #ifdef GHCI @@ -83,8 +82,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this = do { errs_var <- newIORef (emptyBag, emptyBag) ; tvs_var <- newIORef emptyVarSet ; keep_var <- newIORef emptyNameSet ; - used_sel_var <- newIORef Set.empty ; - used_rdr_var <- newIORef Set.empty ; + used_gre_var <- newIORef [] ; th_var <- newIORef False ; th_splice_var<- newIORef False ; infer_var <- newIORef (True, emptyBag) ; @@ -137,8 +135,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this tcg_th_splice_used = th_splice_var, tcg_exports = [], tcg_imports = emptyImportAvails, - tcg_used_selectors = used_sel_var, - tcg_used_rdrnames = used_rdr_var, + tcg_used_gres = used_gre_var, tcg_dus = emptyDUs, tcg_rn_imports = [], diff --git a/compiler/typecheck/TcRnTypes.hs b/compiler/typecheck/TcRnTypes.hs index c046704643..d856250bd6 100644 --- a/compiler/typecheck/TcRnTypes.hs +++ b/compiler/typecheck/TcRnTypes.hs @@ -145,7 +145,6 @@ import ListSetOps import FastString import GHC.Fingerprint -import Data.Set (Set) import Control.Monad (ap, liftM) #ifdef GHCI @@ -400,9 +399,8 @@ data TcGblEnv -- things bound in this module. Also store Safe Haskell info -- here about transative trusted packaage requirements. - tcg_dus :: DefUses, -- ^ What is defined in this module and what is used. - tcg_used_rdrnames :: TcRef (Set RdrName), - tcg_used_selectors :: TcRef (Set (FieldOcc Name)), + tcg_dus :: DefUses, -- ^ What is defined in this module and what is used. + tcg_used_gres :: TcRef [GlobalRdrElt], -- ^ Records occurrences of imported entities -- See Note [Tracking unused binding and imports] tcg_keep :: TcRef NameSet, @@ -585,10 +583,10 @@ data SelfBootInfo -- We need this info to compute a safe approximation to -- recursive loops, to avoid infinite inlinings -{- -Note [Tracking unused binding and imports] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -We gather three sorts of usage information +{- Note [Tracking unused binding and imports] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We gather two sorts of usage information + * tcg_dus (defs/uses) Records *defined* Names (local, top-level) and *used* Names (local or imported) @@ -600,19 +598,15 @@ We gather three sorts of usage information This usage info is mainly gathered by the renamer's gathering of free-variables - * tcg_used_rdrnames - Records used *imported* (not locally-defined) RdrNames + * tcg_used_gres Used only to report unused import declarations - Notice that they are RdrNames, not Names, so we can - tell whether the reference was qualified or unqualified, which - is esssential in deciding whether a particular import decl - is unnecessary. This info isn't present in Names. - - * tcg_used_selectors - Records the record selectors that are used - by the DuplicateRecordFields extension. These - may otherwise be missed from tcg_used_rdrnames as a - single RdrName might refer to multiple fields. + + Records each *occurrence* an *imported* (not locally-defined) entity. + The occurrence is recorded by keeping a GlobalRdrElt for it. + These is not the GRE that is in the GlobalRdrEnv; rather it + is recorded *after* the filtering done by pickGREs. So it reflect + /how that occurrence is in scope/. See Note [GRE filtering] in + RdrName. ************************************************************************ diff --git a/compiler/typecheck/TcSMonad.hs b/compiler/typecheck/TcSMonad.hs index 5303925237..ec1ef18890 100644 --- a/compiler/typecheck/TcSMonad.hs +++ b/compiler/typecheck/TcSMonad.hs @@ -15,7 +15,7 @@ module TcSMonad ( TcS, runTcS, runTcSWithEvBinds, failTcS, tryTcS, nestTcS, nestImplicTcS, recoverTcS, - runTcPluginTcS, addUsedRdrNamesTcS, deferTcSForAllEq, + runTcPluginTcS, addUsedDataCons, deferTcSForAllEq, -- Tracing etc panicTcS, traceTcS, @@ -125,8 +125,8 @@ import TyCon import TcErrors ( solverDepthErrorTcS ) import Name -import RdrName (RdrName, GlobalRdrEnv) -import RnEnv (addUsedRdrNames) +import RdrName ( GlobalRdrEnv) +import qualified RnEnv as TcM import Var import VarEnv import VarSet @@ -2527,8 +2527,8 @@ tcLookupClass c = wrapTcS $ TcM.tcLookupClass c -- Setting names as used (used in the deriving of Coercible evidence) -- Too hackish to expose it to TcS? In that case somehow extract the used -- constructors from the result of solveInteract -addUsedRdrNamesTcS :: [RdrName] -> TcS () -addUsedRdrNamesTcS names = wrapTcS $ addUsedRdrNames names +addUsedDataCons :: GlobalRdrEnv -> TyCon -> TcS () +addUsedDataCons rdr_env tycon = wrapTcS $ TcM.addUsedDataCons rdr_env tycon -- Various smaller utilities [TODO, maybe will be absorbed in the instance matcher] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ diff --git a/testsuite/tests/module/Mod136_A.hs b/testsuite/tests/module/Mod136_A.hs index a69d8ee1a3..00cf2c90f1 100644 --- a/testsuite/tests/module/Mod136_A.hs +++ b/testsuite/tests/module/Mod136_A.hs @@ -1,3 +1,5 @@ -module Mod136_A (module Data.List) where +module Mod136_A ( module Data.List ) where + -- Only things in scope unqualified (from the Prelude) + -- and qualified Data.List.x, will be exported import qualified Data.List diff --git a/testsuite/tests/module/mod136.hs b/testsuite/tests/module/mod136.hs index 1729eea789..c495b685ff 100644 --- a/testsuite/tests/module/mod136.hs +++ b/testsuite/tests/module/mod136.hs @@ -1,6 +1,7 @@ -- !!! Re-exporting qualified module. -module M where +module M where +import Prelude () -- Forces the import to come from Mod136_A import Mod136_A x = zipWith5 diff --git a/testsuite/tests/module/mod136.stderr b/testsuite/tests/module/mod136.stderr index 9726cc3cff..fc5e0d682c 100644 --- a/testsuite/tests/module/mod136.stderr +++ b/testsuite/tests/module/mod136.stderr @@ -1,6 +1,6 @@ -
-mod136.hs:6:5: error:
- Variable not in scope: zipWith5
- Perhaps you meant one of these:
- ‘zipWith’ (imported from Mod136_A),
- ‘zipWith3’ (imported from Mod136_A)
+ +mod136.hs:7:5: error: + Variable not in scope: zipWith5 + Perhaps you meant one of these: + ‘zipWith’ (imported from Mod136_A), + ‘zipWith3’ (imported from Mod136_A) diff --git a/testsuite/tests/rename/should_compile/T4239.stdout b/testsuite/tests/rename/should_compile/T4239.stdout index 25623f0174..05536b7901 100644 --- a/testsuite/tests/rename/should_compile/T4239.stdout +++ b/testsuite/tests/rename/should_compile/T4239.stdout @@ -1 +1 @@ -import T4239A ( type (:+++)((:+++), (:---), X) ) +import T4239A ( type (:+++)((:---), X, (:+++)) ) |