Sig(..), collectGroupBinders, tyClDeclNames
)
import RnEnv
-import IfaceEnv ( lookupOrig, newGlobalBinder )
+import IfaceEnv ( lookupAvail )
import LoadIface ( loadSrcInterface )
import TcRnMonad
import FiniteMap
import PrelNames ( pRELUDE, isUnboundName, main_RDR_Unqual )
-import Module ( Module, moduleUserString,
- unitModuleEnv, unitModuleEnv,
+import Module ( Module, moduleUserString, unitModuleEnv,
lookupModuleEnv, moduleEnvElts, foldModuleEnv )
import Name ( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName,
nameParent, nameParent_maybe, isExternalName,
isLocalGRE, pprNameProvenance )
import Outputable
import Maybes ( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
-import SrcLoc ( noSrcLoc, Located(..), mkGeneralSrcSpan,
+import SrcLoc ( Located(..), mkGeneralSrcSpan,
unLoc, noLoc, srcLocSpan, combineSrcSpans, SrcSpan )
import BasicTypes ( DeprecTxt )
import ListSetOps ( removeDups )
= foldlM do_one emptyNameSet exports
where
do_one acc (mod, exports) = foldlM (do_avail mod) acc exports
- do_avail mod acc (Avail n) = do { n' <- lookupOrig mod n;
- ; return (addOneToNameSet acc n') }
- do_avail mod acc (AvailTC p_occ occs)
- = do { p_name <- lookupOrig mod p_occ
- ; ns <- mappM (lookup_sub p_name) occs
- ; return (addListToNameSet acc ns) }
- -- Remember that 'occs' is all the exported things, including
- -- the parent. It's possible to export just class ops without
- -- the class, via C( op ). If the class was exported too we'd
- -- have C( C, op )
- where
- lookup_sub parent occ
- = newGlobalBinder mod occ mb_parent noSrcLoc
- where
- mb_parent | occ == p_occ = Nothing
- | otherwise = Just parent
-
- -- The use of newGlobalBinder here (rather than lookupOrig)
- -- ensures that the subordinate names record their parent;
- -- and that in turn ensures that the GlobalRdrEnv
- -- has the correct parent for all the names in its range.
- -- For imported things, we only suck in the binding site later, if ever.
- -- Reason for all this:
- -- Suppose module M exports type A.T, and constructor A.MkT
- -- Then, we know that A.MkT is a subordinate name of A.T,
- -- even though we aren't at the binding site of A.T
- -- And it's important, because we may simply re-export A.T
- -- without ever sucking in the declaration itself.
+ do_avail mod acc avail = do { ns <- lookupAvail mod avail
+ ; return (addListToNameSet acc ns) }
warnRedundantSourceImport mod_name
= ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
%*********************************************************
\begin{code}
-reportUnusedNames :: TcGblEnv -> RnM ()
-reportUnusedNames gbl_env
+reportUnusedNames :: Maybe [Located (IE RdrName)] -- Export list
+ -> TcGblEnv -> RnM ()
+reportUnusedNames export_decls gbl_env
= do { warnUnusedTopBinds unused_locals
; warnUnusedModules unused_imp_mods
; warnUnusedImports unused_imports
-- To figure out the minimal set of imports, start with the things
-- that are in scope (i.e. in gbl_env). Then just combine them
-- into a bunch of avails, so they are properly grouped
+ --
+ -- BUG WARNING: this does not deal properly with qualified imports!
minimal_imports :: FiniteMap Module AvailEnv
- minimal_imports0 = emptyFM
+ minimal_imports0 = foldr add_expall emptyFM expall_mods
minimal_imports1 = foldr add_name minimal_imports0 defined_and_used
minimal_imports = foldr add_inst_mod minimal_imports1 direct_import_mods
-- The last line makes sure that we retain all direct imports
add_name other acc
= acc
+ -- Modules mentioned as 'module M' in the export list
+ expall_mods = case export_decls of
+ Nothing -> []
+ Just es -> [m | L _ (IEModuleContents m) <- es]
+
+ -- This is really bogus. The idea is that if we see 'module M' in
+ -- the export list we must retain the import decls that drive it
+ -- If we aren't careful we might see
+ -- module A( module M ) where
+ -- import M
+ -- import N
+ -- and suppose that N exports everything that M does. Then we
+ -- must not drop the import of M even though N brings it all into
+ -- scope.
+ --
+ -- BUG WARNING: 'module M' exports aside, what if M.x is mentioned?!
+ --
+ -- The reason that add_expall is bogus is that it doesn't take
+ -- qualified imports into account. But it's an improvement.
+ add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv
+
-- n is the name of the thing, p is the name of its parent
mk_avail n (Just p) = AvailTC p [p,n]
mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n]
-- that are not mentioned in minimal_imports1
-- [Note: not 'minimal_imports', because that includes directly-imported
-- modules even if we use nothing from them; see notes above]
+ --
+ -- BUG WARNING: does not deal correctly with multiple imports of the same module
+ -- becuase direct_import_mods has only one entry per module
unused_imp_mods = [(mod,loc) | (mod,imp,loc) <- direct_import_mods,
not (mod `elemFM` minimal_imports1),
mod /= pRELUDE,
projects / ghc-hetmet.git / blobdiff