Commit 525898a9 authored by simonpj's avatar simonpj
Browse files

[project @ 2000-07-06 16:31:45 by simonpj]

* Improve the warning "M is imported but nothing from it is used"
  In particular, don't warn if some instances from it are imported.

  It's pretty much impossible to do the Right Thing always.
  A comment in Rename.lhs says
	-- NOTE: Consider
	--	      module This
	--		import M ()
	--
	--	 The import M() is not *necessarily* redundant, even if
	-- 	 we suck in no instance decls from M (e.g. it contains
	--	 no instance decls, or This contains no code).  It may be
	--	 that we import M solely to ensure that M's orphan instance
	--	 decls (or those in its imports) are visible to people who
	--	 import This.  Sigh.
	--	 There's really no good way to detect this, so the error message
	--	 in RnEnv.warnUnusedModules is weakened instead

* Minor comment changes to RnIfaces.lhs

* Use NameEnv instead of UFM in TcEnv (tidy up only)
parent 89cefac8
......@@ -26,7 +26,8 @@ import RnIfaces ( getImportedInstDecls, importDecl, mkImportExportInfo, getInte
getImportedRules, loadHomeInterface, getSlurped, removeContext,
loadBuiltinRules, getDeferredDecls, ImportDeclResult(..)
)
import RnEnv ( availName, availsToNameSet, unitAvailEnv, availEnvElts, plusAvailEnv,
import RnEnv ( availName, availsToNameSet,
emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv,
warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
lookupImplicitOccsRn, pprAvail, unknownNameErr,
FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
......@@ -54,7 +55,9 @@ import Type ( namesOfType, funTyCon )
import ErrUtils ( printErrorsAndWarnings, dumpIfSet, ghcExit )
import BasicTypes ( Version, initialVersion )
import Bag ( isEmptyBag, bagToList )
import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM, addToFM_C )
import FiniteMap ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
addToFM_C, elemFM, addToFM
)
import UniqSupply ( UniqSupply )
import UniqFM ( lookupUFM )
import SrcLoc ( noSrcLoc )
......@@ -192,7 +195,8 @@ rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec l
-- REPORT UNUSED NAMES, AND DEBUG DUMP
reportUnusedNames mod_name direct_import_mods
gbl_env global_avail_env
export_avails source_fvs `thenRn_`
export_avails source_fvs
rn_imp_decls `thenRn_`
returnRn (Just result, dump_action) }
where
......@@ -654,10 +658,12 @@ rnDeprecs gbl_env mod_deprec decls
\begin{code}
reportUnusedNames :: ModuleName -> [ModuleName]
-> GlobalRdrEnv -> AvailEnv
-> Avails -> NameSet -> RnMG ()
-> Avails -> NameSet -> [RenamedHsDecl]
-> RnMG ()
reportUnusedNames mod_name direct_import_mods
gbl_env avail_env
export_avails mentioned_names
imported_decls
= let
used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
......@@ -682,7 +688,8 @@ reportUnusedNames mod_name direct_import_mods
= case lookupNameEnv avail_env sub_name of
Just avail -> avail
Nothing -> WARN( isUserImportedName sub_name,
text "reportUnusedName: not in avail_env" <+> ppr sub_name )
text "reportUnusedName: not in avail_env" <+>
ppr sub_name )
Avail sub_name
, case parent_avail of { AvailTC _ _ -> True; other -> False }
......@@ -702,12 +709,35 @@ reportUnusedNames mod_name direct_import_mods
not (isLocallyDefined n),
Just txt <- [lookupNameEnv deprec_env n] ]
-- inst_mods are directly-imported modules that
-- contain instance decl(s) that the renamer decided to suck in
-- It's not necessarily redundant to import such modules.
-- NOTE: import M () is not necessarily redundant, even if
-- we suck in no instance decls from M (e.g. it contains
-- no instance decls). It may be that we import M solely to
-- ensure that M's orphan instance decls (or those in its imports)
-- are visible to people who import this module. Sigh. There's
-- really no good way to detect this, so the error message is weakened
inst_mods = [m | InstD (InstDecl _ _ _ dfun _) <- imported_decls,
let m = moduleName (nameModule dfun),
m `elem` direct_import_mods
]
minimal_imports :: FiniteMap ModuleName AvailEnv
minimal_imports = foldNameSet add emptyFM really_used_names
add n acc = case maybeUserImportedFrom n of
Nothing -> acc
Just m -> addToFM_C plusAvailEnv acc (moduleName m)
(unitAvailEnv (mk_avail n))
minimal_imports0 = emptyFM
minimal_imports1 = foldNameSet add_name minimal_imports0 really_used_names
minimal_imports = foldr add_inst_mod minimal_imports1 inst_mods
add_name n acc = case maybeUserImportedFrom n of
Nothing -> acc
Just m -> addToFM_C plusAvailEnv acc (moduleName m)
(unitAvailEnv (mk_avail n))
add_inst_mod m acc
| m `elemFM` acc = acc -- We import something already
| otherwise = addToFM acc m emptyAvailEnv
-- Add an empty collection of imports for a module
-- from which we have sucked only instance decls
mk_avail n = case lookupNameEnv avail_env n of
Just (AvailTC m _) | n==m -> AvailTC n [n]
| otherwise -> AvailTC m [n,m]
......
......@@ -763,8 +763,10 @@ warnUnusedModules mods
| not opt_WarnUnusedImports = returnRn ()
| otherwise = mapRn_ (addWarnRn . unused_mod) mods
where
unused_mod m = ptext SLIT("Module") <+> quotes (pprModuleName m) <+>
text "is imported, but nothing from it is used"
unused_mod m = vcat [ptext SLIT("Module") <+> quotes (pprModuleName m) <+>
text "is imported, but nothing from it is used",
parens (ptext SLIT("except perhaps to re-export instances visible in") <+>
quotes (pprModuleName m))]
warnUnusedLocalBinds, warnUnusedImports, warnUnusedMatches :: [Name] -> RnM d ()
warnUnusedImports names
......
......@@ -364,9 +364,9 @@ loadFixDecl mod_name sig@(FixitySig rdr_name fixity loc)
-----------------------------------------------------
loadInstDecl :: Module
-> Bag GatedDecl
-> IfaceInsts
-> RdrNameInstDecl
-> RnM d (Bag GatedDecl)
-> RnM d IfaceInsts
loadInstDecl mod insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
=
-- Find out what type constructors and classes are "gates" for the
......
......@@ -314,21 +314,19 @@ data Ifaces = Ifaces {
-- This is used to generate the "usage" information for this module.
-- Subset of the previous field.
iInsts :: Bag GatedDecl,
iInsts :: IfaceInsts,
-- The as-yet un-slurped instance decls; this bag is depleted when we
-- slurp an instance decl so that we don't slurp the same one twice.
-- Each is 'gated' by the names that must be available before
-- this instance decl is needed.
iRules :: IfaceRules,
-- Similar to instance decls, except that we track the version number of the
-- rules we import from each module
-- [We keep just one rule-version number for each module]
-- The Bool is True if we import any rules at all from that module
-- Similar to instance decls, only for rules
iDeprecs :: DeprecationEnv
}
type IfaceInsts = Bag GatedDecl
type IfaceRules = Bag GatedDecl
type GatedDecl = (NameSet, (Module, RdrNameHsDecl))
......
......@@ -61,7 +61,9 @@ import BasicTypes ( Arity )
import IdInfo ( vanillaIdInfo )
import Name ( Name, OccName, nameOccName, getSrcLoc,
maybeWiredInTyConName, maybeWiredInIdName, isLocallyDefined,
NamedThing(..)
NamedThing(..),
NameEnv, emptyNameEnv, addToNameEnv,
extendNameEnv, lookupNameEnv, nameEnvElts
)
import Unique ( pprUnique10, Unique, Uniquable(..) )
import FiniteMap ( lookupFM, addToFM )
......@@ -147,14 +149,12 @@ data TcEnv = TcEnv
-- ...why mutable? see notes with tcGetGlobalTyVars
-- Includes the in-scope tyvars
type NameEnv val = UniqFM val -- Keyed by Names
type UsageEnv = NameEnv UVar
type TypeEnv = NameEnv (TcKind, TcTyThing)
type ValueEnv = NameEnv Id
valueEnvIds :: ValueEnv -> [Id]
valueEnvIds ve = eltsUFM ve
valueEnvIds ve = nameEnvElts ve
data TcTyThing = ATyVar TcTyVar -- Mutable only so that the kind can be mutable
-- if the kind is mutable, the tyvar must be so that
......@@ -165,11 +165,11 @@ data TcTyThing = ATyVar TcTyVar -- Mutable only so that the kind can be mutable
initEnv :: TcRef TcTyVarSet -> TcEnv
initEnv mut = TcEnv emptyUFM emptyUFM emptyUFM (emptyVarSet, mut)
initEnv mut = TcEnv emptyNameEnv emptyNameEnv emptyNameEnv (emptyVarSet, mut)
getEnvClasses (TcEnv _ te _ _) = [cl | (_, AClass cl _) <- eltsUFM te]
getEnvClasses (TcEnv _ te _ _) = [cl | (_, AClass cl _) <- nameEnvElts te]
getEnvTyCons (TcEnv _ te _ _) = catMaybes (map get_tc (eltsUFM te))
getEnvTyCons (TcEnv _ te _ _) = catMaybes (map get_tc (nameEnvElts te))
where
get_tc (_, ADataTyCon tc) = Just tc
get_tc (_, ASynTyCon tc _) = Just tc
......@@ -193,7 +193,7 @@ Extending the usage environment.
tcExtendUVarEnv :: Name -> UVar -> TcM s r -> TcM s r
tcExtendUVarEnv uv_name uv scope
= tcGetEnv `thenNF_Tc` \ (TcEnv ue te ve gtvs) ->
tcSetEnv (TcEnv (addToUFM ue uv_name uv) te ve gtvs) scope
tcSetEnv (TcEnv (addToNameEnv ue uv_name uv) te ve gtvs) scope
\end{code}
Looking up in the environments.
......@@ -202,7 +202,7 @@ Looking up in the environments.
tcLookupUVar :: Name -> NF_TcM s UVar
tcLookupUVar uv_name
= tcGetEnv `thenNF_Tc` \ (TcEnv ue te ve gtvs) ->
case lookupUFM ue uv_name of
case lookupNameEnv ue uv_name of
Just uv -> returnNF_Tc uv
Nothing -> failWithTc (uvNameOutOfScope uv_name)
\end{code}
......@@ -221,7 +221,7 @@ tcExtendTyVarEnv tyvars scope
extend_list = [ (getName tv, (kindToTcKind (tyVarKind tv), ATyVar tv))
| tv <- tyvars
]
te' = addListToUFM te extend_list
te' = extendNameEnv te extend_list
new_tv_set = mkVarSet tyvars
in_scope_tvs' = in_scope_tvs `unionVarSet` new_tv_set
in
......@@ -244,7 +244,7 @@ tcExtendTyVarEnvForMeths :: [TyVar] -> [TcTyVar] -> TcM s r -> TcM s r
tcExtendTyVarEnvForMeths sig_tyvars inst_tyvars thing_inside
= tcGetEnv `thenNF_Tc` \ (TcEnv ue te ve gtvs) ->
let
te' = addListToUFM te stuff
te' = extendNameEnv te stuff
in
tcSetEnv (TcEnv ue te' ve gtvs) thing_inside
where
......@@ -297,7 +297,7 @@ tcExtendTypeEnv bindings scope
-- Not for tyvars; use tcExtendTyVarEnv
tcGetEnv `thenNF_Tc` \ (TcEnv ue te ve gtvs) ->
let
te' = addListToUFM te bindings
te' = extendNameEnv te bindings
in
tcSetEnv (TcEnv ue te' ve gtvs) scope
\end{code}
......@@ -309,7 +309,7 @@ Looking up in the environments.
tcLookupTy :: Name -> NF_TcM s (TcKind, TcTyThing)
tcLookupTy name
= tcGetEnv `thenNF_Tc` \ (TcEnv ue te ve gtvs) ->
case lookupUFM te name of {
case lookupNameEnv te name of {
Just thing -> returnNF_Tc thing ;
Nothing ->
......@@ -368,7 +368,7 @@ tcExtendLocalValEnv names_w_ids scope
= tcGetEnv `thenNF_Tc` \ (TcEnv ue te ve (in_scope_tvs,gtvs)) ->
tcReadMutVar gtvs `thenNF_Tc` \ global_tvs ->
let
ve' = addListToUFM ve names_w_ids
ve' = extendNameEnv ve names_w_ids
extra_global_tyvars = tyVarsOfTypes (map (idType . snd) names_w_ids)
in
tc_extend_gtvs gtvs extra_global_tyvars `thenNF_Tc` \ gtvs' ->
......@@ -391,7 +391,7 @@ tcLookupValueMaybe name
= case maybeWiredInIdName name of
Just id -> returnNF_Tc (Just id)
Nothing -> tcGetEnv `thenNF_Tc` \ (TcEnv ue te ve gtvs) ->
returnNF_Tc (lookupUFM ve name)
returnNF_Tc (lookupNameEnv ve name)
tcLookupValueByKey :: Unique -> NF_TcM s Id -- Panics if not found
tcLookupValueByKey key
......@@ -424,7 +424,7 @@ explicitLookupValue :: ValueEnv -> Name -> Maybe Id
explicitLookupValue ve name
= case maybeWiredInIdName name of
Just id -> Just id
Nothing -> lookupUFM ve name
Nothing -> lookupNameEnv ve name
-- Extract the IdInfo from an IfaceSig imported from an interface file
tcAddImportedIdInfo :: ValueEnv -> Id -> Id
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment