import CmdLineOpts ( DynFlag(..) )
import HsSyn ( IE(..), ieName, ImportDecl(..), LImportDecl,
- ForeignDecl(..), HsGroup(..),
- collectGroupBinders, tyClDeclNames
+ ForeignDecl(..), HsGroup(..), HsBindGroup(..),
+ Sig(..), collectGroupBinders, tyClDeclNames
)
import RnEnv
import IfaceEnv ( lookupOrig, newGlobalBinder )
IfaceExport, HomePackageTable, PackageIfaceTable,
availNames, unQualInScope,
Deprecs(..), ModIface(..), Dependencies(..),
- lookupIface, ExternalPackageState(..),
- IfacePackage(..)
+ lookupIface, ExternalPackageState(..)
)
+import Packages ( PackageIdH(..) )
import RdrName ( RdrName, rdrNameOcc, setRdrNameSpace,
GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..),
emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
-- Do the non {- SOURCE -} ones first, so that we get a helpful
-- warning for {- SOURCE -} ones that are unnecessary
this_mod <- getModule
- ; opt_no_prelude <- doptM Opt_NoImplicitPrelude
+ ; implicit_prelude <- doptM Opt_ImplicitPrelude
; let
- all_imports = mk_prel_imports this_mod opt_no_prelude ++ imports
+ all_imports = mk_prel_imports this_mod implicit_prelude ++ imports
(source, ordinary) = partition is_source_import all_imports
is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
-- because the former doesn't even look at Prelude.hi for instance
-- declarations, whereas the latter does.
- mk_prel_imports this_mod no_prelude
+ mk_prel_imports this_mod implicit_prelude
| this_mod == pRELUDE
|| explicit_prelude_import
- || no_prelude
+ || not implicit_prelude
= []
| otherwise = [preludeImportDecl]
(dependent_mods, dependent_pkgs)
= case mi_package iface of
- ThisPackage ->
+ HomePackage ->
-- Imported module is from the home package
-- Take its dependent modules and add imp_mod itself
-- Take its dependent packages unchanged
-- check. See LoadIface.loadHiBootInterface
((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)
- ExternalPackage pkg ->
+ ExtPackage pkg ->
-- Imported module is from another package
-- Dump the dependent modules
-- Add the package imp_mod comes from to the dependent packages
exportsToAvails exports
= 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 n ns) = do { n' <- lookupOrig mod n
- ; ns' <- mappM (lookup_sub n') ns
- ; return (addListToNameSet acc (n':ns')) }
+ 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 (Just parent) noSrcLoc
- -- Hack alert! Notice the newGlobalBinder. It 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.
+ 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 may only suck in the interface 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,
-- printer returns False. It seems awkward to fix, unfortunately.
mappM_ addDupDeclErr dups `thenM_`
- doptM Opt_NoImplicitPrelude `thenM` \ implicit_prelude ->
+ doptM Opt_ImplicitPrelude `thenM` \ implicit_prelude ->
let
prov = LocalDef this_mod
gbl_env = mkGlobalRdrEnv gres
-- Sigh. It doesn't matter because it only affects the Data.Tuple really.
-- The important thing is to trim down the exports.
filtered_names
- | implicit_prelude = filter (not . isBuiltInSyntax) all_names
- | otherwise = all_names
+ | implicit_prelude = all_names
+ | otherwise = filter (not . isBuiltInSyntax) all_names
imports = emptyImportAvails {
imp_env = unitModuleEnv this_mod $
-- an export indicator because they are all implicitly exported.
mappM new_tc tycl_decls `thenM` \ tc_avails ->
- mappM new_simple (for_hs_bndrs ++ val_hs_bndrs) `thenM` \ simple_avails ->
- returnM (tc_avails ++ simple_avails)
+
+ -- In a hs-boot file, the value binders come from the
+ -- *signatures*, and there should be no foreign binders
+ tcIsHsBoot `thenM` \ is_hs_boot ->
+ let val_bndrs | is_hs_boot = sig_hs_bndrs
+ | otherwise = for_hs_bndrs ++ val_hs_bndrs
+ in
+ mappM new_simple val_bndrs `thenM` \ names ->
+
+ returnM (tc_avails ++ map Avail names)
where
- new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name `thenM` \ name ->
- returnM (Avail name)
+ new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name
+ sig_hs_bndrs = [nm | HsBindGroup _ lsigs _ <- val_decls,
+ L _ (Sig nm _) <- lsigs]
val_hs_bndrs = collectGroupBinders val_decls
for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]
%*********************************************************
\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