%
-% (c) The GRASP Project, Glasgow University, 1992-1996
+% (c) The GRASP Project, Glasgow University, 1992-1998
%
\section[Rename]{Renaming and dependency analysis passes}
#include "HsVersions.h"
import HsSyn
-import RdrHsSyn ( RdrName(..), RdrNameHsModule, RdrNameImportDecl )
+import RdrHsSyn ( RdrNameHsModule )
import RnHsSyn ( RenamedHsModule, RenamedHsDecl, extractHsTyNames )
-import CmdLineOpts ( opt_HiMap, opt_WarnNameShadowing, opt_D_show_rn_trace,
+import CmdLineOpts ( opt_HiMap, opt_D_show_rn_trace,
opt_D_dump_rn, opt_D_show_rn_stats,
- opt_WarnUnusedNames
+ opt_WarnUnusedBinds, opt_WarnUnusedImports
)
import RnMonad
import RnNames ( getGlobalNames )
-import RnSource ( rnDecl )
+import RnSource ( rnIfaceDecl, rnSourceDecls )
import RnIfaces ( getImportedInstDecls, importDecl, getImportVersions, getSpecialInstModules,
getDeferredDataDecls,
mkSearchPath, getSlurpedNames, getRnStats
)
-import RnEnv ( availsToNameSet, addAvailToNameSet,
- addImplicitOccsRn, lookupImplicitOccRn )
-import Name ( Name, PrintUnqualified, Provenance, ExportFlag(..),
- isLocallyDefined,
- NameSet(..), elemNameSet, mkNameSet, unionNameSets,
- nameSetToList, minusNameSet, NamedThing(..),
- nameModule, pprModule, pprOccName, nameOccName
+import RnEnv ( addImplicitOccsRn, availName, availNames, availsToNameSet,
+ warnUnusedTopNames
)
-import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon )
+import Module ( pprModule )
+import Name ( Name, isLocallyDefined,
+ NamedThing(..), ImportReason(..), Provenance(..),
+ nameModule, pprOccName, nameOccName,
+ getNameProvenance, occNameUserString,
+ )
+import RdrName ( RdrName )
+import NameSet
import TyCon ( TyCon )
-import PrelMods ( mAIN, gHC_MAIN )
-import PrelInfo ( ioTyCon_NAME )
+import PrelMods ( mAIN, pREL_MAIN )
+import TysWiredIn ( unitTyCon, intTyCon, doubleTyCon )
+import PrelInfo ( ioTyCon_NAME, thinAirIdNames )
+import Type ( funTyCon )
import ErrUtils ( pprBagOfErrors, pprBagOfWarnings,
doIfSet, dumpIfSet, ghcExit
)
-import FiniteMap ( emptyFM, eltsFM, fmToList, addToFM, FiniteMap )
import Bag ( isEmptyBag )
+import FiniteMap ( fmToList, delListFromFM )
import UniqSupply ( UniqSupply )
import Util ( equivClasses )
import Maybes ( maybeToBool )
-import List ( partition )
import Outputable
\end{code}
\begin{code}
renameModule :: UniqSupply
-> RdrNameHsModule
- -> IO (Maybe (RenamedHsModule, -- Output, after renaming
- InterfaceDetails, -- Interface; for interface file generatino
- RnNameSupply, -- Final env; for renaming derivings
- [Module])) -- Imported modules; for profiling
-
-renameModule us this_mod@(HsModule mod_name vers exports imports fixities local_decls loc)
+ -> IO (Maybe
+ ( RenamedHsModule -- Output, after renaming
+ , InterfaceDetails -- Interface; for interface file generatino
+ , RnNameSupply -- Final env; for renaming derivings
+ , [Module] -- Imported modules; for profiling
+ ))
+
+renameModule us this_mod@(HsModule mod_name vers exports imports local_decls loc)
= -- Initialise the renamer monad
initRn mod_name us (mkSearchPath opt_HiMap) loc
(rename this_mod) >>=
\begin{code}
-rename this_mod@(HsModule mod_name vers exports imports fixities local_decls loc)
+rename this_mod@(HsModule mod_name vers exports imports local_decls loc)
= -- FIND THE GLOBAL NAME ENVIRONMENT
getGlobalNames this_mod `thenRn` \ maybe_stuff ->
returnRn Nothing
else
let
- Just (export_env, rn_env, explicit_names, print_unqual) = maybe_stuff
+ Just (export_env, rn_env, global_avail_env) = maybe_stuff
in
-- RENAME THE SOURCE
- initRnMS rn_env mod_name SourceMode (
+ initRnMS rn_env SourceMode (
addImplicits mod_name `thenRn_`
- mapRn rnDecl local_decls
- ) `thenRn` \ rn_local_decls ->
+ rnSourceDecls local_decls
+ ) `thenRn` \ (rn_local_decls, fvs) ->
-- SLURP IN ALL THE NEEDED DECLARATIONS
- slurpDecls print_unqual rn_local_decls `thenRn` \ rn_all_decls ->
+ slurpDecls rn_local_decls `thenRn` \ rn_all_decls ->
-- EXIT IF ERRORS FOUND
checkErrsRn `thenRn` \ no_errs_so_far ->
getNameSupplyRn `thenRn` \ name_supply ->
-- REPORT UNUSED NAMES
- reportUnusedNames explicit_names `thenRn_`
+ reportUnusedNames rn_env global_avail_env
+ export_env
+ fvs `thenRn_`
-- GENERATE THE SPECIAL-INSTANCE MODULE LIST
-- The "special instance" modules are those modules that contain instance
-- RETURN THE RENAMED MODULE
let
- import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
+ import_mods = [mod | ImportDecl mod _ _ _ _ <- imports]
renamed_module = HsModule mod_name vers
- trashed_exports trashed_imports trashed_fixities
+ trashed_exports trashed_imports
rn_all_decls
loc
in
where
trashed_exports = {-trace "rnSource:trashed_exports"-} Nothing
trashed_imports = {-trace "rnSource:trashed_imports"-} []
- trashed_fixities = []
\end{code}
@addImplicits@ forces the renamer to slurp in some things which aren't
\begin{code}
addImplicits mod_name
- = addImplicitOccsRn (implicit_main ++ default_tys)
+ = addImplicitOccsRn (implicit_main ++ default_tys ++ thinAirIdNames)
where
-- Add occurrences for Int, Double, and (), because they
-- are the types to which ambigious type variables may be defaulted by
- -- the type checker; so they won't every appear explicitly.
+ -- the type checker; so they won't always appear explicitly.
-- [The () one is a GHC extension for defaulting CCall results.]
- default_tys = [getName intTyCon, getName doubleTyCon, getName unitTyCon ]
+ -- ALSO: funTyCon, since it occurs implicitly everywhere!
+ -- (we don't want to be bothered with addImplicitOcc at every
+ -- function application)
+ default_tys = [getName intTyCon, getName doubleTyCon,
+ getName unitTyCon, getName funTyCon]
-- Add occurrences for IO or PrimIO
implicit_main | mod_name == mAIN
- || mod_name == gHC_MAIN = [ioTyCon_NAME]
- | otherwise = []
+ || mod_name == pREL_MAIN = [ioTyCon_NAME]
+ | otherwise = []
\end{code}
\begin{code}
-slurpDecls print_unqual decls
+slurpDecls decls
= -- First of all, get all the compulsory decls
slurp_compulsories decls `thenRn` \ decls1 ->
returnRn (rn_data_decls ++ decls2)
where
- compulsory_mode = InterfaceMode Compulsory print_unqual
- optional_mode = InterfaceMode Optional print_unqual
+ compulsory_mode = InterfaceMode Compulsory
+ optional_mode = InterfaceMode Optional
-- The "slurp_compulsories" function is a loop that alternates
-- between slurping compulsory decls and slurping the instance
\end{code}
\begin{code}
-closeDecls :: RnSMode
+closeDecls :: RnMode
-> [RenamedHsDecl] -- Declarations got so far
-> RnMG [RenamedHsDecl] -- input + extra decls slurped
-- The monad includes a list of possibly-unresolved Names
mod_name = nameModule (fst name_w_loc)
rn_iface_decl mod_name mode decl
- = initRnMS emptyRnEnv mod_name mode (rnDecl decl)
+ = setModuleRn mod_name $
+ initRnMS emptyRnEnv mode (rnIfaceDecl decl)
-rn_inst_decl mode (mod_name,decl) = rn_iface_decl mod_name mode (InstD decl)
-rn_data_decl mode (tycon_name,ty_decl) = rn_iface_decl mod_name mode (TyD ty_decl)
- where
- mod_name = nameModule tycon_name
+rn_inst_decl mode (mod_name,decl) = rn_iface_decl mod_name mode (InstD decl)
+rn_data_decl mode (mod_name,ty_decl) = rn_iface_decl mod_name mode (TyClD ty_decl)
\end{code}
\begin{code}
-reportUnusedNames explicit_avail_names
- | not opt_WarnUnusedNames
+reportUnusedNames (RnEnv gbl_env _) avail_env (ExportEnv export_avails _) mentioned_names
+ | not (opt_WarnUnusedBinds || opt_WarnUnusedImports)
= returnRn ()
| otherwise
- = getSlurpedNames `thenRn` \ slurped_names ->
- let
- unused = explicit_avail_names `minusNameSet` slurped_names
- (local_unused, imported_unused) = partition isLocallyDefined (nameSetToList unused)
- imports_by_module = equivClasses cmp imported_unused
- name1 `cmp` name2 = nameModule name1 `compare` nameModule name2
-
- pp_imp = sep [text "For information: the following unqualified imports are unused:",
- nest 4 (vcat (map pp_group imports_by_module))]
- pp_group (n:ns) = sep [hcat [text "Module ", pprModule (nameModule n), char ':'],
- nest 4 (sep (map (pprOccName . nameOccName) (n:ns)))]
-
- pp_local = sep [text "For information: the following local top-level definitions are unused:",
- nest 4 (sep (map (pprOccName . nameOccName) local_unused))]
+ = let
+ used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
+
+ -- Now, a use of C implies a use of T,
+ -- if C was brought into scope by T(..) or T(C)
+ really_used_names = used_names `unionNameSets`
+ mkNameSet [ availName avail
+ | sub_name <- nameSetToList used_names,
+ let avail = case lookupNameEnv avail_env sub_name of
+ Just avail -> avail
+ Nothing -> pprTrace "r.u.n" (ppr sub_name) $
+ Avail sub_name
+ ]
+
+ defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
+ defined_but_not_used = nameSetToList (defined_names `minusNameSet` really_used_names)
+
+ -- Filter out the ones only defined implicitly
+ bad_guys = filter reportableUnusedName defined_but_not_used
in
- (if null imported_unused
- then returnRn ()
- else addWarnRn pp_imp) `thenRn_`
+ warnUnusedTopNames bad_guys `thenRn_`
+ returnRn ()
- (if null local_unused
- then returnRn ()
- else addWarnRn pp_local)
+reportableUnusedName :: Name -> Bool
+reportableUnusedName name
+ = explicitlyImported (getNameProvenance name) &&
+ not (startsWithUnderscore (occNameUserString (nameOccName name)))
+ where
+ explicitlyImported (LocalDef _ _) = True -- Report unused defns of local vars
+ explicitlyImported (NonLocalDef (UserImport _ _ expl) _) = expl -- Report unused explicit imports
+ explicitlyImported other = False -- Don't report others
+
+ -- Haskell 98 encourages compilers to suppress warnings about
+ -- unused names in a pattern if they start with "_".
+ startsWithUnderscore ('_' : _) = True -- Suppress warnings for names starting
+ startsWithUnderscore other = False -- with an underscore
rnStats :: [RenamedHsDecl] -> RnMG ()
rnStats all_decls
projects / ghc-hetmet.git / blobdiff