X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=ccdf18b775ac8057372bb930c918cec80971ab39;hb=e3dd39bf230380f02d73efc287226117bb2eb47f;hp=90cf81fc5f86dc305bc0211e1bce816d2bc029d6;hpb=9530e7922d07ac2272e26078c6c626a333d1a761;p=ghc-hetmet.git diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 90cf81f..ccdf18b 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -17,7 +17,7 @@ import DynFlags ( DynFlag(..), GhcMode(..), DynFlags(..) ) import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl, ForeignDecl(..), HsGroup(..), HsValBinds(..), Sig(..), collectHsBindLocatedBinders, tyClDeclNames, - instDeclATs, isIdxTyDecl, + instDeclATs, isFamInstDecl, LIE ) import RnEnv import RnHsDoc ( rnHsDoc ) @@ -30,28 +30,12 @@ import Module import Name import NameEnv import NameSet -import OccName ( srcDataName, pprNonVarNameSpace, - occNameSpace, - OccEnv, mkOccEnv, mkOccEnv_C, lookupOccEnv, - emptyOccEnv, extendOccEnv ) -import HscTypes ( GenAvailInfo(..), AvailInfo, availNames, availName, - HomePackageTable, PackageIfaceTable, - mkPrintUnqualified, availsToNameSet, - Deprecs(..), ModIface(..), Dependencies(..), - lookupIfaceByModule, ExternalPackageState(..) - ) -import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace, Parent(..), - GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), - emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts, - extendGlobalRdrEnv, lookupGlobalRdrEnv, - lookupGRE_RdrName, lookupGRE_Name, - Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), - importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance, - unQualSpecOK, qualSpecOK ) +import OccName +import HscTypes +import RdrName import Outputable import Maybes -import SrcLoc ( Located(..), mkGeneralSrcSpan, getLoc, - unLoc, noLoc, srcLocSpan, SrcSpan ) +import SrcLoc import FiniteMap import ErrUtils import BasicTypes ( DeprecTxt ) @@ -81,29 +65,16 @@ rnImports imports -- warning for {- SOURCE -} ones that are unnecessary = do this_mod <- getModule implicit_prelude <- doptM Opt_ImplicitPrelude - let all_imports = mk_prel_imports this_mod implicit_prelude ++ imports - (source, ordinary) = partition is_source_import all_imports + let prel_imports = mkPrelImports this_mod implicit_prelude imports + (source, ordinary) = partition is_source_import imports is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot - stuff1 <- mapM (rnImportDecl this_mod) ordinary + stuff1 <- mapM (rnImportDecl this_mod) (prel_imports ++ ordinary) stuff2 <- mapM (rnImportDecl this_mod) source let (decls, rdr_env, imp_avails) = combine (stuff1 ++ stuff2) return (decls, rdr_env, imp_avails) where --- NB: opt_NoImplicitPrelude is slightly different to import Prelude (); --- because the former doesn't even look at Prelude.hi for instance --- declarations, whereas the latter does. - mk_prel_imports this_mod implicit_prelude - | this_mod == pRELUDE - || explicit_prelude_import - || not implicit_prelude - = [] - | otherwise = [preludeImportDecl] - explicit_prelude_import - = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, - unLoc mod == pRELUDE_NAME ] - combine :: [(LImportDecl Name, GlobalRdrEnv, ImportAvails)] -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails) combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails) @@ -113,18 +84,34 @@ rnImports imports gbl_env1 `plusGlobalRdrEnv` gbl_env2, imp_avails1 `plusImportAvails` imp_avails2) -preludeImportDecl :: LImportDecl RdrName -preludeImportDecl - = L loc $ - ImportDecl (L loc pRELUDE_NAME) +mkPrelImports :: Module -> Bool -> [LImportDecl RdrName] -> [LImportDecl RdrName] +-- Consruct the implicit declaration "import Prelude" (or not) +-- +-- NB: opt_NoImplicitPrelude is slightly different to import Prelude (); +-- because the former doesn't even look at Prelude.hi for instance +-- declarations, whereas the latter does. +mkPrelImports this_mod implicit_prelude import_decls + | this_mod == pRELUDE + || explicit_prelude_import + || not implicit_prelude + = [] + | otherwise = [preludeImportDecl] + where + explicit_prelude_import + = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- import_decls, + unLoc mod == pRELUDE_NAME ] + + preludeImportDecl :: LImportDecl RdrName + preludeImportDecl + = L loc $ + ImportDecl (L loc pRELUDE_NAME) False {- Not a boot interface -} False {- Not qualified -} Nothing {- No "as" -} Nothing {- No import list -} - where - loc = mkGeneralSrcSpan FSLIT("Implicit import declaration") - + loc = mkGeneralSrcSpan FSLIT("Implicit import declaration") + rnImportDecl :: Module -> LImportDecl RdrName @@ -192,7 +179,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot -- filter the imports according to the import declaration (new_imp_details, gbl_env) <- - filterImports2 iface imp_spec imp_details total_avails + filterImports iface imp_spec imp_details total_avails dflags <- getDOpts @@ -349,7 +336,7 @@ getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls] new_tc tc_decl - | isIdxTyDecl (unLoc tc_decl) + | isFamInstDecl (unLoc tc_decl) = do { main_name <- lookupFamInstDeclBndr mod main_rdr ; sub_names <- mappM (newTopSrcBinder mod) sub_rdrs ; return (AvailTC main_name sub_names) } @@ -541,134 +528,6 @@ catMaybeErr :: [MaybeErr err a] -> [a] catMaybeErr ms = [ a | Succeeded a <- ms ] \end{code} -\begin{code} -filterImports2 :: ModIface - -> ImpDeclSpec -- The span for the entire import decl - -> Maybe (Bool, [LIE RdrName]) -- Import spec; True => hiding - -> [AvailInfo] -- What's available - -> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names - GlobalRdrEnv) -- Same again, but in GRE form - -filterImports2 iface decl_spec Nothing all_avails - = return (Nothing, mkGlobalRdrEnv (gresFromAvails prov all_avails)) - where - prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }] - - -filterImports2 iface decl_spec (Just (want_hiding, import_items)) all_avails - = do -- check for errors, convert RdrNames to Names - opt_indexedtypes <- doptM Opt_IndexedTypes - items1 <- mapM (lookup_lie opt_indexedtypes) import_items - - let items2 :: [(LIE Name, AvailInfo)] - items2 = concat items1 - -- NB the AvailInfo may have duplicates, and several items - -- for the same parent; e.g N(x) and N(y) - - names = availsToNameSet (map snd items2) - keep n = not (n `elemNameSet` names) - pruned_avails = filterAvails keep all_avails - hiding_prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }] - - gres | want_hiding = gresFromAvails hiding_prov pruned_avails - | otherwise = concatMap (gresFromIE decl_spec) items2 - - return (Just (want_hiding, map fst items2), mkGlobalRdrEnv gres) - where - -- This environment is how we map names mentioned in the import - -- list to the actual Name they correspond to, and the family - -- that the Name belongs to (an AvailInfo). - -- - -- This env will have entries for data constructors too, - -- they won't make any difference because naked entities like T - -- in an import list map to TcOccs, not VarOccs. - occ_env :: OccEnv (Name,AvailInfo) - occ_env = mkOccEnv [ (nameOccName n, (n,a)) - | a <- all_avails, n <- availNames a ] - - lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)] - lookup_lie opt_indexedtypes (L loc ieRdr) - = do - stuff <- setSrcSpan loc $ - case lookup_ie opt_indexedtypes ieRdr of - Failed err -> addErr err >> return [] - Succeeded a -> return a - checkDodgyImport stuff - return [ (L loc ie, avail) | (ie,avail) <- stuff ] - where - -- Warn when importing T(..) if T was exported abstractly - checkDodgyImport stuff - | IEThingAll n <- ieRdr, (_, AvailTC _ [one]):_ <- stuff - = ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n)) - -- NB. use the RdrName for reporting the warning - checkDodgyImport _ - = return () - - -- For each import item, we convert its RdrNames to Names, - -- and at the same time construct an AvailInfo corresponding - -- to what is actually imported by this item. - -- Returns Nothing on error. - -- We return a list here, because in the case of an import - -- item like C, if we are hiding, then C refers to *both* a - -- type/class and a data constructor. - lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)] - lookup_ie opt_indexedtypes ie - = let bad_ie = Failed (badImportItemErr iface decl_spec ie) - - lookup_name rdrName = - case lookupOccEnv occ_env (rdrNameOcc rdrName) of - Nothing -> bad_ie - Just n -> return n - in - case ie of - IEVar n -> do - (name,avail) <- lookup_name n - return [(IEVar name, trimAvail avail name)] - - IEThingAll tc -> do - (name,avail) <- lookup_name tc - return [(IEThingAll name, avail)] - - IEThingAbs tc - | want_hiding -- hiding ( C ) - -- Here the 'C' can be a data constructor - -- *or* a type/class, or even both - -> let tc_name = lookup_name tc - dc_name = lookup_name (setRdrNameSpace tc srcDataName) - in - case catMaybeErr [ tc_name, dc_name ] of - [] -> bad_ie - names -> return [ (IEThingAbs n, trimAvail av n) - | (n,av) <- names ] - | otherwise - -> do (name,avail) <- lookup_name tc - return [(IEThingAbs name, AvailTC name [name])] - - IEThingWith n ns -> do - (name,avail) <- lookup_name n - case avail of - AvailTC nm subnames | nm == name -> do - let env = mkOccEnv [ (nameOccName s, s) - | s <- subnames ] - let mb_children = map (lookupOccEnv env . rdrNameOcc) ns - children <- - if any isNothing mb_children - then bad_ie - else return (catMaybes mb_children) - -- check for proper import of indexed types - when (not opt_indexedtypes && any isTyConName children) $ - Failed (typeItemErr (head . filter isTyConName - $ children ) - (text "in import list")) - return [(IEThingWith name children, AvailTC name (name:children))] - - _otherwise -> bad_ie - - _other -> Failed illegalImportItemErr - -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed - -- all errors. -\end{code} - %************************************************************************ %* * Import/Export Utils @@ -940,14 +799,13 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod return (IEVar (gre_name gre), greAvail gre) lookup_ie (IEThingAbs rdr) - = do name <- lookupGlobalOccRn rdr - case lookupGRE_RdrName rdr rdr_env of - [] -> panic "RnNames.lookup_ie" - elt:_ -> case gre_par elt of - NoParent -> return (IEThingAbs name, - AvailTC name [name]) - ParentIs p -> return (IEThingAbs name, - AvailTC p [name]) + = do gre <- lookupGreRn rdr + let name = gre_name gre + case gre_par gre of + NoParent -> return (IEThingAbs name, + AvailTC name [name]) + ParentIs p -> return (IEThingAbs name, + AvailTC p [name]) lookup_ie ie@(IEThingAll rdr) = do name <- lookupGlobalOccRn rdr @@ -1060,7 +918,7 @@ reportDeprecations dflags tcg_env check hpt pit gre@(GRE {gre_name = name, gre_prov = Imported (imp_spec:_)}) | name `elemNameSet` used_names - , Just deprec_txt <- lookupDeprec dflags hpt pit gre + , Just deprec_txt <- lookupImpDeprec dflags hpt pit gre = addWarnAt (importSpecLoc imp_spec) (sep [ptext SLIT("Deprecated use of") <+> pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> @@ -1082,9 +940,10 @@ reportDeprecations dflags tcg_env -- the defn of a non-deprecated thing, when changing a module's -- interface -lookupDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable - -> GlobalRdrElt -> Maybe DeprecTxt -lookupDeprec dflags hpt pit gre +lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable + -> GlobalRdrElt -> Maybe DeprecTxt +-- The name is definitely imported, so look in HPT, PIT +lookupImpDeprec dflags hpt pit gre = case lookupIfaceByModule dflags hpt pit (nameModule name) of Just iface -> mi_dep_fn iface name `seqMaybe` -- Bleat if the thing, *or case gre_par gre of @@ -1154,14 +1013,15 @@ reportUnusedNames export_decls gbl_env is_unused_local :: GlobalRdrElt -> Bool is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre) - unused_imports :: [GlobalRdrElt] - unused_imports = filter unused_imp defined_but_not_used - unused_imp (GRE {gre_prov = Imported 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 + unused_imports :: [GlobalRdrElt] + unused_imports = mapCatMaybes unused_imp defined_but_not_used + unused_imp :: GlobalRdrElt -> Maybe GlobalRdrElt -- Result has trimmed Imported provenances + unused_imp gre@(GRE {gre_prov = LocalDef}) = Nothing + unused_imp gre@(GRE {gre_prov = Imported imp_specs}) + | null trimmed_specs = Nothing + | otherwise = Just (gre {gre_prov = Imported trimmed_specs}) + where + trimmed_specs = filter report_if_unused imp_specs -- To figure out the minimal set of imports, start with the things -- that are in scope (i.e. in gbl_env). Then just combine them @@ -1237,6 +1097,7 @@ reportUnusedNames export_decls gbl_env -- -- BUG WARNING: does not deal correctly with multiple imports of the same module -- becuase direct_import_mods has only one entry per module + unused_imp_mods :: [(ModuleName, SrcSpan)] unused_imp_mods = [(mod_name,loc) | (mod,no_imp,loc) <- direct_import_mods, let mod_name = moduleName mod, not (mod_name `elemFM` minimal_imports1), @@ -1249,6 +1110,12 @@ reportUnusedNames export_decls gbl_env module_unused :: ModuleName -> Bool module_unused mod = any (((==) mod) . fst) unused_imp_mods + report_if_unused :: ImportSpec -> Bool + -- Do we want to report this as an unused import? + report_if_unused (ImpSpec {is_decl = d, is_item = i}) + = not (module_unused (is_mod d)) -- Not if we've already said entire import is unused + && isExplicitItem i -- Only if the import was explicit + --------------------- warnDuplicateImports :: [GlobalRdrElt] -> RnM () -- Given the GREs for names that are used, figure out which imports @@ -1267,8 +1134,6 @@ warnDuplicateImports :: [GlobalRdrElt] -> RnM () warnDuplicateImports gres = ifOptM Opt_WarnUnusedImports $ sequenceM_ [ warn name pr - -- The 'head' picks the first offending group - -- for this particular name | GRE { gre_name = name, gre_prov = Imported imps } <- gres , pr <- redundants imps ] where @@ -1287,7 +1152,12 @@ warnDuplicateImports gres redundants imps = [ (red_imp, cov_imp) | red_imp <- imps + , isExplicitItem (is_item red_imp) + -- Complain only about redundant imports + -- mentioned explicitly by the user , cov_imp <- take 1 (filter (covers red_imp) imps) ] + -- The 'take 1' picks the first offending group + -- for this particular name -- "red_imp" is a putative redundant import -- "cov_imp" potentially covers it @@ -1308,6 +1178,10 @@ warnDuplicateImports gres = False -- They bring into scope different qualified names | not (is_qual red_decl) && is_qual cov_decl = False -- Covering one doesn't bring unqualified name into scope + | otherwise + = not (isExplicitItem cov_item) -- Redundant one is selective and covering one isn't + || red_later -- or both are explicit; tie-break using red_later +{- | red_selective = not cov_selective -- Redundant one is selective and covering one isn't || red_later -- Both are explicit; tie-break using red_later @@ -1315,16 +1189,11 @@ warnDuplicateImports gres = 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 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 ModuleName AvailEnv -- Minimal imports