X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=d82bea968ca46b797f80b876c5eb153bc7f0c463;hb=eb86e5a2aa0792c7826eef681048ce3b21633a18;hp=781de3190e18046b3753a64c41f367099cb534fa;hpb=7bb3d1fc79521d591cd9f824893963141a7997b6;p=ghc-hetmet.git diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 781de31..d82bea9 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -21,6 +21,7 @@ import IfaceEnv ( ifaceExportNames ) import LoadIface ( loadSrcInterface, loadSysInterface ) import TcRnMonad hiding (LIE) +import HeaderInfo ( mkPrelImports ) import PrelNames import Module import Name @@ -38,8 +39,8 @@ import FastString import ListSetOps import Data.List ( partition, (\\), delete ) import qualified Data.Set as Set -import IO ( openFile, IOMode(..) ) -import Monad ( when, mplus ) +import System.IO +import Control.Monad \end{code} @@ -60,7 +61,7 @@ rnImports imports -- warning for {- SOURCE -} ones that are unnecessary = do this_mod <- getModule implicit_prelude <- doptM Opt_ImplicitPrelude - let prel_imports = mkPrelImports this_mod implicit_prelude imports + let prel_imports = mkPrelImports (moduleName this_mod) implicit_prelude imports (source, ordinary) = partition is_source_import imports is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot @@ -84,36 +85,6 @@ rnImports imports imp_avails1 `plusImportAvails` imp_avails2, hpc_usage1 || hpc_usage2) -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 Nothing _ _ _ _) <- import_decls, - unLoc mod == pRELUDE_NAME ] - - preludeImportDecl :: LImportDecl RdrName - preludeImportDecl - = L loc $ - ImportDecl (L loc pRELUDE_NAME) - Nothing {- no specific package -} - False {- Not a boot interface -} - False {- Not qualified -} - Nothing {- No "as" -} - Nothing {- No import list -} - - loc = mkGeneralSrcSpan (fsLit "Implicit import declaration") - - rnImportDecl :: Module -> LImportDecl RdrName -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage) @@ -580,10 +551,10 @@ filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails lookup_ie opt_typeFamilies 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 + lookup_name rdr + | isQual rdr = Failed (qualImportItemErr rdr) + | Just nm <- lookupOccEnv occ_env (rdrNameOcc rdr) = return nm + | otherwise = bad_ie in case ie of IEVar n -> do @@ -722,7 +693,7 @@ gresFromIE decl_spec (L loc ie, avail) mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name] mkChildEnv gres = foldr add emptyNameEnv gres where - add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_C (++) env p [n] + add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_Acc (:) singleton env p n add _ env = env findChildren :: NameEnv [Name] -> Name -> [Name] @@ -893,6 +864,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod | otherwise = do { implicit_prelude <- doptM Opt_ImplicitPrelude + ; warnDodgyExports <- doptM Opt_WarnDodgyExports ; let { exportValid = (mod `elem` imported_modules) || (moduleName this_mod == mod) ; gres = filter (isModuleExported implicit_prelude mod) @@ -901,7 +873,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod } ; checkErr exportValid (moduleNotImported mod) - ; warnIf (exportValid && null gres) (nullModuleExport mod) + ; warnIf (warnDodgyExports && exportValid && null gres) (nullModuleExport mod) ; addUsedRdrNames (concat [ [mkRdrQual mod occ, mkRdrUnqual occ] | occ <- map nameOccName names ]) @@ -951,12 +923,18 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod lookup_ie ie@(IEThingAll rdr) = do name <- lookupGlobalOccRn rdr let kids = findChildren kids_env name - when (null kids) - (if (isTyConName name) then addWarn (dodgyExportWarn name) - -- This occurs when you export T(..), but - -- only import T abstractly, or T is a synonym. - else addErr (exportItemErr ie)) - + mkKidRdrName = case isQual_maybe rdr of + Nothing -> mkRdrUnqual + Just (modName, _) -> mkRdrQual modName + addUsedRdrNames $ map (mkKidRdrName . nameOccName) kids + warnDodgyExports <- doptM Opt_WarnDodgyExports + when (null kids) $ + if isTyConName name + then when warnDodgyExports $ addWarn (dodgyExportWarn name) + else -- This occurs when you export T(..), but + -- only import T abstractly, or T is a synonym. + addErr (exportItemErr ie) + return (IEThingAll name, AvailTC name (name:kids)) lookup_ie ie@(IEThingWith rdr sub_rdrs) @@ -1297,20 +1275,20 @@ isImpAll _other = False \begin{code} warnUnusedImport :: ImportDeclUsage -> RnM () -warnUnusedImport (L loc decl, used, unused) - | Just (False,[]) <- ideclHiding decl - = return () -- Do not warn for 'import M()' +warnUnusedImport (L loc decl, used, unused) + | Just (False,[]) <- ideclHiding decl + = return () -- Do not warn for 'import M()' | null used = addWarnAt loc msg1 -- Nothing used; drop entire decl - | null unused = return () -- Everything imported is used; nop + | null unused = return () -- Everything imported is used; nop | otherwise = addWarnAt loc msg2 -- Some imports are unused where msg1 = vcat [pp_herald <+> quotes pp_mod <+> pp_not_used, - nest 2 (ptext (sLit "except perhaps to import instances from") - <+> quotes pp_mod), - ptext (sLit "To import instances alone, use:") - <+> ptext (sLit "import") <+> pp_mod <> parens empty ] + nest 2 (ptext (sLit "except perhaps to import instances from") + <+> quotes pp_mod), + ptext (sLit "To import instances alone, use:") + <+> ptext (sLit "import") <+> pp_mod <> parens empty ] msg2 = sep [pp_herald <+> quotes (pprWithCommas ppr unused), - text "from module" <+> quotes pp_mod <+> pp_not_used] + text "from module" <+> quotes pp_mod <+> pp_not_used] pp_herald = text "The import of" pp_mod = ppr (unLoc (ideclName decl)) pp_not_used = text "is redundant" @@ -1379,6 +1357,11 @@ printMinimalImports imports_w_usage %************************************************************************ \begin{code} +qualImportItemErr :: RdrName -> SDoc +qualImportItemErr rdr + = hang (ptext (sLit "Illegal qualified name in import item:")) + 2 (ppr rdr) + badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc badImportItemErr iface decl_spec ie = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import, @@ -1468,11 +1451,11 @@ nullModuleExport mod moduleWarn :: ModuleName -> WarningTxt -> SDoc moduleWarn mod (WarningTxt txt) = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"), - nest 4 (ppr txt) ] + nest 2 (vcat (map ppr txt)) ] moduleWarn mod (DeprecatedTxt txt) = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <+> ptext (sLit "is deprecated:"), - nest 4 (ppr txt) ] + nest 2 (vcat (map ppr txt)) ] implicitPreludeWarn :: SDoc implicitPreludeWarn