module RnNames (
rnImports, getLocalNonValBinders,
rnExports, extendGlobalRdrEnvRn,
- reportUnusedNames, finishDeprecations,
+ reportUnusedNames, finishWarnings,
) where
#include "HsVersions.h"
import SrcLoc
import FiniteMap
import ErrUtils
-import BasicTypes ( DeprecTxt )
+import BasicTypes ( WarningTxt(..) )
import DriverPhases ( isHsBoot )
import Util
import FastString
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)
| 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" -}
-> 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
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
}
-- 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)
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)
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
-- 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
%*********************************************************
\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
| 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
-- 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]
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
(_, 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
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}
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}
projects / ghc-hetmet.git / blobdiff