+%*********************************************************
+%* *
+ Deprecations
+%* *
+%*********************************************************
+
+\begin{code}
+reportDeprecations :: TcGblEnv -> RnM ()
+reportDeprecations tcg_env
+ = ifOptM Opt_WarnDeprecations $
+ do { (eps,hpt) <- getEpsAndHpt
+ ; mapM_ (check hpt (eps_PIT eps)) all_gres }
+ where
+ used_names = findUses (tcg_dus tcg_env) emptyNameSet
+ all_gres = globalRdrEnvElts (tcg_rdr_env tcg_env)
+
+ check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_) _})
+ | name `elemNameSet` used_names
+ , Just deprec_txt <- lookupDeprec hpt pit name
+ = setSrcSpan (is_loc imp_spec) $
+ addWarn (sep [ptext SLIT("Deprecated use of") <+>
+ occNameFlavour (nameOccName name) <+>
+ quotes (ppr name),
+ (parens imp_msg),
+ (ppr deprec_txt) ])
+ where
+ name_mod = nameModule name
+ imp_mod = is_mod imp_spec
+ imp_msg = ptext SLIT("imported from") <+> ppr imp_mod <> extra
+ extra | imp_mod == name_mod = empty
+ | otherwise = ptext SLIT(", but defined in") <+> ppr name_mod
+
+ check hpt pit ok_gre = returnM () -- 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
+ -- deprecated things. We may even use a deprecated thing in
+ -- the defn of a non-deprecated thing, when changing a module's
+ -- interface
+
+lookupDeprec :: HomePackageTable -> PackageIfaceTable
+ -> Name -> Maybe DeprecTxt
+lookupDeprec hpt pit n
+ = case lookupIface hpt pit (nameModule n) of
+ Just iface -> mi_dep_fn iface n `seqMaybe` -- Bleat if the thing, *or
+ mi_dep_fn iface (nameParent n) -- its parent*, is deprec'd
+ Nothing
+ | isWiredInName n -> Nothing
+ -- We have not necessarily loaded the .hi file for a
+ -- wired-in name (yet), although we *could*.
+ -- And we never deprecate them
+
+ | otherwise -> pprPanic "lookupDeprec" (ppr n)
+ -- By now all the interfaces should have been loaded
+
+gre_is_used :: NameSet -> GlobalRdrElt -> Bool
+gre_is_used used_names gre = gre_name gre `elemNameSet` used_names
+\end{code}
+
+%*********************************************************
+%* *
+ Unused names
+%* *
+%*********************************************************
+
+\begin{code}
+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
+ ; warnDuplicateImports dup_imps
+ ; printMinimalImports minimal_imports }
+ where
+ used_names, all_used_names :: NameSet
+ used_names = findUses (tcg_dus gbl_env) emptyNameSet
+ all_used_names = used_names `unionNameSets`
+ mkNameSet (mapCatMaybes nameParent_maybe (nameSetToList used_names))
+ -- A use of C implies a use of T,
+ -- if C was brought into scope by T(..) or T(C)
+
+ -- Collect the defined names from the in-scope environment
+ defined_names :: [GlobalRdrElt]
+ defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
+
+ -- Note that defined_and_used, defined_but_not_used
+ -- are both [GRE]; that's why we need defined_and_used
+ -- rather than just all_used_names
+ defined_and_used, defined_but_not_used :: [GlobalRdrElt]
+ (defined_and_used, defined_but_not_used)
+ = partition (gre_is_used all_used_names) defined_names
+
+ -- Find the duplicate imports
+ dup_imps = filter is_dup defined_and_used
+ is_dup (GRE {gre_prov = Imported imp_spec True}) = not (isSingleton imp_spec)
+ is_dup other = False
+
+ -- Filter out the ones that are
+ -- (a) defined in this module, and
+ -- (b) not defined by a 'deriving' clause
+ -- The latter have an Internal Name, so we can filter them out easily
+ unused_locals :: [GlobalRdrElt]
+ unused_locals = filter is_unused_local defined_but_not_used
+ is_unused_local :: GlobalRdrElt -> Bool
+ is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
+
+ unused_imports :: [GlobalRdrElt]
+ unused_imports = filter unused_imp defined_but_not_used
+ unused_imp (GRE {gre_prov = Imported imp_specs True})
+ = not (all (module_unused . is_mod) imp_specs)
+ -- Don't complain about unused imports if we've already said the
+ -- entire import is unused
+ unused_imp other = False
+
+ -- 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 = 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
+ -- even if we import nothing explicitly.
+ -- It's not necessarily redundant to import such modules. 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
+
+ -- We've carefully preserved the provenance so that we can
+ -- construct minimal imports that import the name by (one of)
+ -- the same route(s) as the programmer originally did.
+ add_name (GRE {gre_name = n, gre_prov = Imported imp_specs _}) acc
+ = addToFM_C plusAvailEnv acc (is_mod (head imp_specs))
+ (unitAvailEnv (mk_avail n (nameParent_maybe n)))
+ 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]
+ | otherwise = Avail n
+
+ add_inst_mod (mod,_,_) acc
+ | mod `elemFM` acc = acc -- We import something already
+ | otherwise = addToFM acc mod emptyAvailEnv
+ where
+ -- Add an empty collection of imports for a module
+ -- from which we have sucked only instance decls
+
+ imports = tcg_imports gbl_env
+
+ direct_import_mods :: [(Module, Maybe Bool, SrcSpan)]
+ -- See the type of the imp_mods for this triple
+ direct_import_mods = moduleEnvElts (imp_mods imports)
+
+ -- unused_imp_mods are the directly-imported modules
+ -- 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,
+ imp /= Just False]
+ -- The Just False part is not to complain about
+ -- import M (), which is an idiom for importing
+ -- instance declarations
+
+ module_unused :: Module -> Bool
+ module_unused mod = any (((==) mod) . fst) unused_imp_mods
+
+---------------------
+warnDuplicateImports :: [GlobalRdrElt] -> RnM ()
+warnDuplicateImports gres
+ = ifOptM Opt_WarnUnusedImports (mapM_ warn gres)
+ where
+ warn (GRE { gre_name = name, gre_prov = Imported imps _ })
+ = addWarn ((quotes (ppr name) <+> ptext SLIT("is imported more than once:"))
+ $$ nest 2 (vcat (map ppr imps)))
+
+
+-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
+printMinimalImports :: FiniteMap Module AvailEnv -- Minimal imports
+ -> RnM ()
+printMinimalImports imps
+ = ifOptM Opt_D_dump_minimal_imports $ do {
+
+ mod_ies <- mappM to_ies (fmToList imps) ;
+ this_mod <- getModule ;
+ rdr_env <- getGlobalRdrEnv ;
+ ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ;
+ printForUser h (unQualInScope rdr_env)
+ (vcat (map ppr_mod_ie mod_ies)) })
+ }
+ where
+ mkFilename this_mod = moduleUserString this_mod ++ ".imports"
+ ppr_mod_ie (mod_name, ies)
+ | mod_name == pRELUDE
+ = empty
+ | null ies -- Nothing except instances comes from here
+ = ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("() -- Instances only")
+ | otherwise
+ = ptext SLIT("import") <+> ppr mod_name <>
+ parens (fsep (punctuate comma (map ppr ies)))
+
+ to_ies (mod, avail_env) = mappM to_ie (availEnvElts avail_env) `thenM` \ ies ->
+ returnM (mod, ies)
+
+ to_ie :: AvailInfo -> RnM (IE Name)
+ -- The main trick here is that if we're importing all the constructors
+ -- we want to say "T(..)", but if we're importing only a subset we want
+ -- to say "T(A,B,C)". So we have to find out what the module exports.
+ to_ie (Avail n) = returnM (IEVar n)
+ to_ie (AvailTC n [m]) = ASSERT( n==m )
+ returnM (IEThingAbs n)
+ to_ie (AvailTC n ns)
+ = loadSrcInterface doc n_mod False `thenM` \ iface ->
+ case [xs | (m,as) <- mi_exports iface,
+ m == n_mod,
+ AvailTC x xs <- as,
+ x == nameOccName n] of
+ [xs] | all_used xs -> returnM (IEThingAll n)
+ | otherwise -> returnM (IEThingWith n (filter (/= n) ns))
+ other -> pprTrace "to_ie" (ppr n <+> ppr n_mod <+> ppr other) $
+ returnM (IEVar n)
+ where
+ all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
+ doc = text "Compute minimal imports from" <+> ppr n
+ n_mod = nameModule n
+\end{code}
+
+