\section[RnNames]{Extracting imported and top-level names in scope}
\begin{code}
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module RnNames (
rnImports, getLocalNonValBinders,
rnExports, extendGlobalRdrEnvRn,
- reportUnusedNames, finishDeprecations,
+ reportUnusedNames, finishWarnings,
) where
#include "HsVersions.h"
import DynFlags
-import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl,
- ForeignDecl(..), HsGroup(..), HsValBindsLR(..),
- Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
- instDeclATs, isFamInstDecl,
- LIE )
+import HsSyn
import RnEnv
import RnHsDoc ( rnHsDoc )
import IfaceEnv ( ifaceExportNames )
import Module
import Name
import NameEnv
-import LazyUniqFM
import NameSet
import OccName
import HscTypes
import SrcLoc
import FiniteMap
import ErrUtils
-import BasicTypes ( DeprecTxt, Fixity )
+import BasicTypes ( WarningTxt(..) )
import DriverPhases ( isHsBoot )
import Util
import FastString
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
-- True <=> import M ()
import_all = case imp_details of
Just (is_hiding, ls) -> not is_hiding && null ls
- other -> False
+ _ -> 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,
}
-- Complain if we import a deprecated module
- ifOptM Opt_WarnDeprecations (
- case deprecs of
- DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
- other -> 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
return (new_imp_decl, gbl_env, imports, mi_hpc iface)
)
+warnRedundantSourceImport :: ModuleName -> SDoc
warnRedundantSourceImport mod_name
= ptext (sLit "Unnecessary {-# SOURCE #-} in the import of module")
<+> quotes (ppr mod_name)
(rdr_env2, lcl_env2) | shadowP = (rdr_env1, lcl_env1)
| otherwise = (rdr_env, lcl_env)
- ; (rdr_env', fix_env') <- foldlM extend (rdr_env2, fix_env) gres
+ rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres
+ fix_env' = foldl extend_fix_env fix_env gres
+ (rdr_env', dups) = findLocalDupsRdrEnv rdr_env3 new_occs
+
+ gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
+
+ ; mapM_ addDupDeclErr dups
- ; let gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env'))
; return (gbl_env', lcl_env2) }
where
gres = gresFromAvails LocalDef avails
- extend envs@(cur_rdr_env, cur_fix_env) gre
- = let gres = lookupGlobalRdrEnv cur_rdr_env (nameOccName (gre_name gre))
- in case filter isLocalGRE gres of -- Check for existing *local* defns
- dup_gre:_ -> do { addDupDeclErr (gre_name dup_gre) (gre_name gre)
- ; return envs }
- [] -> return (simple_extend envs gre)
-
- simple_extend (rdr_env, fix_env) gre
- = (extendGlobalRdrEnv rdr_env gre, fix_env')
- where
-- If there is a fixity decl for the gre, add it to the fixity env
+ extend_fix_env fix_env gre
+ | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
+ = extendNameEnv fix_env name (FixItem occ fi)
+ | otherwise
+ = fix_env
+ where
name = gre_name gre
occ = nameOccName name
- fix_env' = case lookupFsEnv new_fixities (occNameFS occ) of
- Nothing -> fix_env
- Just (L _ fi) -> extendNameEnv fix_env name (FixItem occ fi)
\end{code}
@getLocalDeclBinders@ returns the names for an @HsDecl@. It's
= do { gbl_env <- getGblEnv
; get_local_binders gbl_env group }
+get_local_binders :: TcGblEnv -> HsGroup RdrName -> RnM [GenAvailInfo Name]
get_local_binders gbl_env (HsGroup {hs_valds = ValBindsIn _ val_sigs,
hs_tyclds = tycl_decls,
hs_instds = inst_decls,
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)
inst_ats inst_decl
= mapM new_tc (instDeclATs (unLoc inst_decl))
-getLocalDeclBinders _ _ = panic "getLocalDeclBinders" -- ValBindsOut can't happen
+get_local_binders _ g = pprPanic "get_local_binders" (ppr g)
\end{code}
-> [AvailInfo] -- What's available
-> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names
GlobalRdrEnv) -- Same again, but in GRE form
-
-filterImports iface decl_spec Nothing all_avails
+filterImports _ decl_spec Nothing all_avails
= return (Nothing, mkGlobalRdrEnv (gresFromAvails prov all_avails))
where
prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]
(parent, subs) = if p1 == name then (p2, subs1) else (p1, subs2)
in
(name, AvailTC name subs, Just parent)
+ combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
lookup_lie opt_typeFamilies (L loc ieRdr)
where
-- Warn when importing T(..) if T was exported abstractly
checkDodgyImport stuff
- | IEThingAll n <- ieRdr, (_, AvailTC _ [one]):_ <- stuff
+ | IEThingAll n <- ieRdr, (_, AvailTC _ [_]):_ <- stuff
= ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
-- NB. use the RdrName for reporting the warning
checkDodgyImport _
return [mkIEThingAbs nameAvail]
IEThingWith tc ns -> do
- (name, AvailTC name2 subnames, mb_parent) <- lookup_name tc
+ (name, AvailTC _ subnames, mb_parent) <- lookup_name tc
let
env = mkOccEnv [(nameOccName s, s) | s <- subnames]
mb_children = map (lookupOccEnv env . rdrNameOcc) ns
where
mkIEThingAbs (n, av, Nothing ) = (IEThingAbs n, trimAvail av n)
- mkIEThingAbs (n, av, Just parent) = (IEThingAbs n, AvailTC parent [n])
+ mkIEThingAbs (n, _, Just parent) = (IEThingAbs n, AvailTC parent [n])
catMaybeErr :: [MaybeErr err a] -> [a]
mkUnitAvail me NoParent | isTyConName me = AvailTC me [me]
| otherwise = Avail me
-plusAvail (Avail n1) (Avail n2) = Avail n1
-plusAvail (AvailTC n1 ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
+plusAvail :: GenAvailInfo Name -> GenAvailInfo Name -> GenAvailInfo Name
+plusAvail (Avail n1) (Avail _) = Avail n1
+plusAvail (AvailTC _ ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
availParent :: Name -> AvailInfo -> Parent
-availParent n (Avail _) = NoParent
-availParent n (AvailTC m ms) | n==m = NoParent
- | otherwise = ParentIs m
+availParent _ (Avail _) = NoParent
+availParent n (AvailTC m _) | n == m = NoParent
+ | otherwise = ParentIs m
trimAvail :: AvailInfo -> Name -> AvailInfo
-trimAvail (Avail n) m = Avail n
+trimAvail (Avail n) _ = Avail n
trimAvail (AvailTC n ns) m = ASSERT( m `elem` ns) AvailTC n [m]
-- | filters 'AvailInfo's by the given predicate
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
where
is_explicit = case ie of
- IEThingAll name -> \n -> n==name
- other -> \n -> True
+ IEThingAll name -> \n -> n == name
+ _ -> \_ -> True
prov_fn name = Imported [imp_spec]
where
imp_spec = ImpSpec { is_decl = decl_spec, is_item = item_spec }
mkChildEnv gres = foldr add emptyNameEnv gres
where
add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_C (++) env p [n]
- add other_gre env = env
+ add _ env = env
findChildren :: NameEnv [Name] -> Name -> [Name]
findChildren env n = lookupNameEnv env n `orElse` []
[AvailInfo]) -- The accumulated exported stuff
-- Not nub'd!
+emptyExportAccum :: ExportAccum
emptyExportAccum = ([], emptyOccEnv, [])
type ExportOccMap = OccEnv (Name, IE RdrName)
-> Module
-> RnM (Maybe [LIE Name], [AvailInfo])
-exports_from_avail Nothing rdr_env imports this_mod
+exports_from_avail Nothing rdr_env _imports _this_mod
= -- The same as (module M) where M is the current module name,
-- so that's how we handle it.
let
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
(text "in export list"))
return (IEThingWith name names, AvailTC name (name:names))
- lookup_ie ie = panic "lookup_ie" -- Other cases covered earlier
+ lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier
-------------
lookup_doc_ie :: IE RdrName -> RnM (IE Name)
lookup_doc_ie (IEDoc doc) = do rn_doc <- rnHsDoc doc
return (IEDoc rn_doc)
lookup_doc_ie (IEDocNamed str) = return (IEDocNamed str)
- lookup_doc_ie ie = panic "lookup_doc_ie" -- Other cases covered earlier
+ lookup_doc_ie _ = panic "lookup_doc_ie" -- Other cases covered earlier
+isDoc :: IE RdrName -> Bool
isDoc (IEDoc _) = True
isDoc (IEDocNamed _) = True
isDoc (IEGroup _ _) = True
-- 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,
extra | imp_mod == moduleName name_mod = empty
| otherwise = ptext (sLit ", but defined in") <+> ppr name_mod
- check hpt pit ok_gre = return () -- Local, or not used, or not deprectated
+ check _ _ _ = return () -- Local, or not used, or not deprectated
-- The Imported pattern-match: don't deprecate locally defined names
-- For a start, we may be exporting a deprecated thing
-- Also we may use a deprecated thing in the defn of another
-- 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]
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
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_prov = LocalDef}) = Nothing
unused_imp gre@(GRE {gre_prov = Imported imp_specs})
| null trimmed_specs = Nothing
| otherwise = Just (gre {gre_prov = Imported trimmed_specs})
add_name gre@(GRE {gre_prov = Imported (imp_spec:_)}) acc
= addToFM_C plusAvailEnv acc
(importSpecModule imp_spec) (unitAvailEnv (greAvail gre))
- add_name gre acc = acc -- Local
+ add_name _ acc = acc -- Local
-- Modules mentioned as 'module M' in the export list
expall_mods = case export_decls of
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
-- either import would change the qualified names in scope (M.x, N.x)
-- But if the qualified names aren't used, the import is indeed redundant
-- Sadly we don't know that. Oh well.
- covers red_imp@(ImpSpec { is_decl = red_decl, is_item = red_item })
+ covers red_imp@(ImpSpec { is_decl = red_decl })
cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
| red_loc == cov_loc
= False -- Ignore diagonal elements
%************************************************************************
\begin{code}
+badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
badImportItemErr iface decl_spec ie
= sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
ptext (sLit "does not export"), quotes (ppr ie)]
source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
| otherwise = empty
+illegalImportItemErr :: SDoc
illegalImportItemErr = ptext (sLit "Illegal import item")
+dodgyImportWarn :: RdrName -> SDoc
dodgyImportWarn item = dodgyMsg (ptext (sLit "import")) item
+dodgyExportWarn :: Name -> SDoc
dodgyExportWarn item = dodgyMsg (ptext (sLit "export")) item
+dodgyMsg :: OutputableBndr n => SDoc -> n -> SDoc
dodgyMsg kind tc
= sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") <+> quotes (ppr (IEThingAll tc)),
ptext (sLit "suggests that") <+> quotes (ppr tc) <+> ptext (sLit "has constructors or class methods,"),
ptext (sLit "but it has none") ]
-
+
+exportItemErr :: IE RdrName -> SDoc
exportItemErr export_item
= sep [ ptext (sLit "The export item") <+> quotes (ppr export_item),
ptext (sLit "attempts to export constructors or class methods that are not visible here") ]
+typeItemErr :: Name -> SDoc -> SDoc
typeItemErr name wherestr
= sep [ ptext (sLit "Using 'type' tag on") <+> quotes (ppr name) <+> wherestr,
ptext (sLit "Use -XTypeFamilies to enable this extension") ]
then (name1, ie1, name2, ie2)
else (name2, ie2, name1, ie1)
-addDupDeclErr :: Name -> Name -> TcRn ()
-addDupDeclErr name_a name_b
- = addErrAt (srcLocSpan loc2) $
- vcat [ptext (sLit "Multiple declarations of") <+> quotes (ppr name1),
- ptext (sLit "Declared at:") <+> vcat [ppr (nameSrcLoc name1), ppr loc2]]
- where
- loc2 = nameSrcLoc name2
- (name1,name2) | nameSrcLoc name_a > nameSrcLoc name_b = (name_b,name_a)
- | otherwise = (name_a,name_b)
+addDupDeclErr :: [Name] -> TcRn ()
+addDupDeclErr []
+ = panic "addDupDeclErr: empty list"
+addDupDeclErr names@(name : _)
+ = addErrAt (getSrcSpan (last sorted_names)) $
-- Report the error at the later location
+ vcat [ptext (sLit "Multiple declarations of") <+> quotes (ppr name),
+ ptext (sLit "Declared at:") <+> vcat (map (ppr . nameSrcLoc) sorted_names)]
+ where
+ sorted_names = sortWith nameSrcLoc names
+dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc
dupExportWarn occ_name ie1 ie2
= hsep [quotes (ppr occ_name),
ptext (sLit "is exported by"), quotes (ppr ie1),
ptext (sLit "and"), quotes (ppr ie2)]
+dupModuleExport :: ModuleName -> SDoc
dupModuleExport mod
= hsep [ptext (sLit "Duplicate"),
quotes (ptext (sLit "Module") <+> ppr mod),
= ptext (sLit "The export item `module") <+> ppr mod <>
ptext (sLit "' is not imported")
+nullModuleExport :: ModuleName -> SDoc
nullModuleExport mod
= ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing")
-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")
\end{code}