X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Frename%2FRnNames.lhs;h=9a95a85b78a428745423f5286bee0ebf569e746c;hb=83256c875683894a93cf4468947ccf11c65577ca;hp=ae730c7d693c04c8312a102e8247a30e31b8236a;hpb=479f9fcbe056864fd5daff01d0e00d4a432b3658;p=ghc-hetmet.git diff --git a/compiler/rename/RnNames.lhs b/compiler/rename/RnNames.lhs index ae730c7..9a95a85 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 @@ -143,7 +143,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 @@ -225,7 +225,7 @@ rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name want_boot _ -> False imports = ImportAvails { - imp_mods = unitModuleEnv imp_mod (imp_mod, [(qual_mod_name, import_all, loc)]), + imp_mods = unitModuleEnv imp_mod [(qual_mod_name, import_all, loc)], imp_orphs = orphans, imp_finsts = finsts, imp_dep_mods = mkModDeps dependent_mods, @@ -233,10 +233,10 @@ 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 @@ -372,13 +372,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 +636,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 @@ -805,7 +808,7 @@ exports_from_avail (Just rdr_items) rdr_env imports this_mod kids_env = mkChildEnv (globalRdrEnvElts rdr_env) imported_modules = [ qual_name - | (_, xs) <- moduleEnvElts $ imp_mods imports, + | xs <- moduleEnvElts $ imp_mods imports, (qual_name, _, _) <- xs ] exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum @@ -926,7 +929,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 +969,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,7 +995,7 @@ 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, @@ -1013,13 +1016,13 @@ 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 + 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] @@ -1038,7 +1041,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 @@ -1176,7 +1179,7 @@ reportUnusedNames export_decls gbl_env direct_import_mods :: [(Module, [(ModuleName, Bool, SrcSpan)])] -- See the type of the imp_mods for this triple - direct_import_mods = moduleEnvElts (imp_mods imports) + direct_import_mods = fmToList (imp_mods imports) -- unused_imp_mods are the directly-imported modules -- that are not mentioned in minimal_imports1 @@ -1428,10 +1431,14 @@ 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