X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=68286b7ac67589ed91911fb932ec92f2e5d54928;hp=67b1dd1ec731ad8af3be74e852e02c998a22aa78;hb=66579ff945831c5fc9a17c58c722ff01f2268d76;hpb=526c3af1dc98987b6949f4df73c0debccf9875bd diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index 67b1dd1..68286b7 100644 --- a/compiler/rename/RnNames.lhs +++ b/compiler/rename/RnNames.lhs @@ -7,7 +7,7 @@ module RnNames ( rnImports, getLocalNonValBinders, rnExports, extendGlobalRdrEnvRn, - reportUnusedNames, finishDeprecations, + reportUnusedNames, finishWarnings, ) where #include "HsVersions.h" @@ -33,7 +33,7 @@ import Maybes import SrcLoc import FiniteMap import ErrUtils -import BasicTypes ( DeprecTxt ) +import BasicTypes ( WarningTxt(..) ) import DriverPhases ( isHsBoot ) import Util import FastString @@ -63,7 +63,7 @@ rnImports imports implicit_prelude <- doptM Opt_ImplicitPrelude 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 + is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot ifOptM Opt_WarnImplicitPrelude ( when (notNull prel_imports) $ addWarn (implicitPreludeWarn) @@ -99,13 +99,14 @@ mkPrelImports this_mod implicit_prelude import_decls | otherwise = [preludeImportDecl] where explicit_prelude_import - = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- import_decls, + = 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" -} @@ -118,18 +119,22 @@ rnImportDecl :: Module -> LImportDecl RdrName -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage) -rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot +rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot qual_only as_mod imp_details)) = setSrcSpan loc $ do + when (isJust mb_pkg) $ do + pkg_imports <- doptM Opt_PackageImports + when (not pkg_imports) $ addErr packageImportErr + -- If there's an error in loadInterface, (e.g. interface -- file not found) we get lots of spurious errors from 'filterImports' let imp_mod_name = unLoc loc_imp_mod_name doc = ppr imp_mod_name <+> ptext (sLit "is directly imported") - iface <- loadSrcInterface doc imp_mod_name want_boot + iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg -- Compiler sanity check: if the import didn't say -- {-# SOURCE #-} we should not get a hi-boot file @@ -143,7 +148,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot let imp_mod = mi_module iface - deprecs = mi_deprecs iface + warns = mi_warns iface orph_iface = mi_orphan iface has_finsts = mi_finsts iface deps = mi_deps iface @@ -233,13 +238,13 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot } -- Complain if we import a deprecated module - ifOptM Opt_WarnDeprecations ( - case deprecs of - DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt) - _ -> return () + ifOptM Opt_WarnWarningsDeprecations ( + case warns of + WarnAll txt -> addWarn (moduleWarn imp_mod_name txt) + _ -> return () ) - let new_imp_decl = L loc (ImportDecl loc_imp_mod_name want_boot + let new_imp_decl = L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot qual_only as_mod new_imp_details) return (new_imp_decl, gbl_env, imports, mi_hpc iface) @@ -372,13 +377,16 @@ get_local_binders gbl_env (HsGroup {hs_valds = ValBindsIn _ val_sigs, mod = tcg_mod gbl_env is_hs_boot = isHsBoot (tcg_src gbl_env) ; + for_hs_bndrs :: [Located RdrName] for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls] -- In a hs-boot file, the value binders come from the -- *signatures*, and there should be no foreign binders + val_bndrs :: [Located RdrName] val_bndrs | is_hs_boot = [nm | L _ (TypeSig nm _) <- val_sigs] | otherwise = for_hs_bndrs + new_simple :: Located RdrName -> RnM (GenAvailInfo Name) new_simple rdr_name = do nm <- newTopSrcBinder mod rdr_name return (Avail nm) @@ -633,7 +641,7 @@ filterAvail keep ie rest = let left = filter keep ns in if null left then rest else AvailTC tc left : rest --- | Given an import/export spec, construct the appropriate 'GlobalRdrElt's. +-- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's. gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt] gresFromIE decl_spec (L loc ie, avail) = gresFromAvail prov_fn avail @@ -926,7 +934,7 @@ isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov }) -- 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 -fno-implicit-prelude as a clue that the filter is + -- 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 @@ -966,23 +974,23 @@ check_occs ie occs names %********************************************************* \begin{code} -finishDeprecations :: DynFlags -> Maybe DeprecTxt - -> TcGblEnv -> RnM TcGblEnv --- (a) Report usasge of deprecated imports --- (b) If the whole module is deprecated, update tcg_deprecs --- All this happens only once per module -finishDeprecations dflags mod_deprec tcg_env +finishWarnings :: DynFlags -> Maybe WarningTxt + -> TcGblEnv -> RnM TcGblEnv +-- (a) Report usage of imports that are deprecated or have other warnings +-- (b) If the whole module is warned about or deprecated, update tcg_warns +-- All this happens only once per module +finishWarnings dflags mod_warn tcg_env = do { (eps,hpt) <- getEpsAndHpt - ; ifOptM Opt_WarnDeprecations $ + ; ifOptM Opt_WarnWarningsDeprecations $ mapM_ (check hpt (eps_PIT eps)) all_gres -- By this time, typechecking is complete, -- so the PIT is fully populated - -- Deal with a module deprecation; it overrides all existing deprecs - ; let new_deprecs = case mod_deprec of - Just txt -> DeprecAll txt - Nothing -> tcg_deprecs tcg_env - ; return (tcg_env { tcg_deprecs = new_deprecs }) } + -- Deal with a module deprecation; it overrides all existing warns + ; let new_warns = case mod_warn of + Just txt -> WarnAll txt + Nothing -> tcg_warns tcg_env + ; return (tcg_env { tcg_warns = new_warns }) } where used_names = allUses (tcg_dus tcg_env) -- Report on all deprecated uses; hence allUses @@ -992,13 +1000,13 @@ finishDeprecations dflags mod_deprec tcg_env | name `elemNameSet` used_names , Just deprec_txt <- lookupImpDeprec dflags hpt pit gre = addWarnAt (importSpecLoc imp_spec) - (sep [ptext (sLit "Deprecated use of") <+> + (sep [ptext (sLit "In the use of") <+> pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> quotes (ppr name), (parens imp_msg) <> colon, (ppr deprec_txt) ]) where - name_mod = nameModule name + name_mod = ASSERT2( isExternalName name, ppr name ) nameModule name imp_mod = importSpecModule imp_spec imp_msg = ptext (sLit "imported from") <+> ppr imp_mod <> extra extra | imp_mod == moduleName name_mod = empty @@ -1013,18 +1021,19 @@ finishDeprecations dflags mod_deprec tcg_env -- interface lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable - -> GlobalRdrElt -> Maybe DeprecTxt + -> GlobalRdrElt -> Maybe WarningTxt -- 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 `mplus` -- Bleat if the thing, *or + = case lookupIfaceByModule dflags hpt pit mod of + Just iface -> mi_warn_fn iface name `mplus` -- Bleat if the thing, *or case gre_par gre of - ParentIs p -> mi_dep_fn iface p -- its parent*, is deprec'd + ParentIs p -> mi_warn_fn iface p -- its parent*, is warn'd NoParent -> Nothing Nothing -> Nothing -- See Note [Used names with interface not loaded] where - name = gre_name gre + name = gre_name gre + mod = ASSERT2( isExternalName name, ppr name ) nameModule name \end{code} Note [Used names with interface not loaded] @@ -1038,7 +1047,7 @@ a) It might be a WiredInName; in that case we may not load its interface (although we could). b) It might be GHC.Real.fromRational, or GHC.Num.fromInteger - These are seen as "used" by the renamer (if -fno-implicit-prelude) + These are seen as "used" by the renamer (if -XNoImplicitPrelude) is on), but the typechecker may discard their uses if in fact the in-scope fromRational is GHC.Read.fromRational, (see tcPat.tcOverloadedLit), and the typechecker sees that the type @@ -1190,7 +1199,10 @@ reportUnusedNames export_decls gbl_env (_, no_imp, loc) <- xs, let mod_name = moduleName mod, not (mod_name `elemFM` minimal_imports1), - mod /= pRELUDE, + moduleName mod /= pRELUDE_NAME, + -- XXX not really correct, but we don't want + -- to generate warnings when compiling against + -- a compat version of base. not no_imp] -- The not no_imp part is not to complain about -- import M (), which is an idiom for importing @@ -1332,7 +1344,7 @@ printMinimalImports imps where all_used avail_occs = all (`elem` map nameOccName ns) avail_occs doc = text "Compute minimal imports from" <+> ppr n - n_mod = nameModule n + n_mod = ASSERT( isExternalName n ) nameModule n \end{code} @@ -1428,12 +1440,20 @@ nullModuleExport :: ModuleName -> SDoc nullModuleExport mod = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing") -moduleDeprec :: ModuleName -> DeprecTxt -> SDoc -moduleDeprec mod txt - = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <+> ptext (sLit "is deprecated:"), - nest 4 (ppr txt) ] +moduleWarn :: ModuleName -> WarningTxt -> SDoc +moduleWarn mod (WarningTxt txt) + = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"), + nest 4 (ppr txt) ] +moduleWarn mod (DeprecatedTxt txt) + = sep [ ptext (sLit "Module") <+> quotes (ppr mod) + <+> ptext (sLit "is deprecated:"), + nest 4 (ppr txt) ] implicitPreludeWarn :: SDoc implicitPreludeWarn = ptext (sLit "Module `Prelude' implicitly imported") + +packageImportErr :: SDoc +packageImportErr + = ptext (sLit "Package-qualified imports are not enabled; use -XPackageImports") \end{code}