ghc/compiler/rename/Rename.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-1998
   3 %
   4 \section[Rename]{Renaming and dependency analysis passes}
   5
   6 \begin{code}
   7 module Rename ( renameModule ) where
   8
   9 #include "HsVersions.h"
  10
  11 import HsSyn
  12 import RdrHsSyn         ( RdrNameHsModule )
  13 import RnHsSyn          ( RenamedHsModule, RenamedHsDecl,
  14                           extractHsTyNames, extractHsCtxtTyNames
  15                         )
  16
  17 import CmdLineOpts      ( opt_HiMap, opt_D_dump_rn_trace,
  18                           opt_D_dump_rn, opt_D_dump_rn_stats,
  19                           opt_WarnUnusedBinds, opt_WarnUnusedImports
  20                         )
  21 import RnMonad
  22 import RnNames          ( getGlobalNames )
  23 import RnSource         ( rnSourceDecls, rnDecl )
  24 import RnIfaces         ( getImportedInstDecls, importDecl, getImportVersions,
  25                           getImportedRules, loadHomeInterface, getSlurped, removeContext
  26                         )
  27 import RnEnv            ( availName, availNames, availsToNameSet,
  28                           warnUnusedImports, warnUnusedLocalBinds, mapFvRn, lookupImplicitOccRn,
  29                           FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs
  30                         )
  31 import Module           ( Module, ModuleName, pprModule, mkSearchPath, mkThisModule )
  32 import Name             ( Name, isLocallyDefined,
  33                           NamedThing(..), ImportReason(..), Provenance(..),
  34                           pprOccName, nameOccName, nameUnique,
  35                           getNameProvenance, isUserImportedExplicitlyName,
  36                           maybeWiredInTyConName, maybeWiredInIdName, isWiredInName
  37                         )
  38 import Id               ( idType )
  39 import DataCon          ( dataConTyCon, dataConType )
  40 import TyCon            ( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
  41 import RdrName          ( RdrName )
  42 import NameSet
  43 import PrelMods         ( mAIN_Name, pREL_MAIN_Name )
  44 import TysWiredIn       ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
  45 import PrelInfo         ( ioTyCon_NAME, thinAirIdNames, fractionalClassKeys, derivingOccurrences )
  46 import Type             ( namesOfType, funTyCon )
  47 import ErrUtils         ( printErrorsAndWarnings, dumpIfSet, ghcExit )
  48 import BasicTypes       ( NewOrData(..) )
  49 import Bag              ( isEmptyBag, bagToList )
  50 import FiniteMap        ( fmToList, delListFromFM, addToFM, sizeFM, eltsFM )
  51 import UniqSupply       ( UniqSupply )
  52 import UniqFM           ( lookupUFM )
  53 import Util             ( equivClasses )
  54 import Maybes           ( maybeToBool )
  55 import SrcLoc           ( mkBuiltinSrcLoc )
  56 import Outputable
  57 \end{code}
  58
  59
  60
  61 \begin{code}
  62 renameModule :: UniqSupply
  63              -> RdrNameHsModule
  64              -> IO (Maybe
  65                       ( Module
  66                       , RenamedHsModule   -- Output, after renaming
  67                       , InterfaceDetails  -- Interface; for interface file generation
  68                       , RnNameSupply      -- Final env; for renaming derivings
  69                       , [ModuleName]      -- Imported modules; for profiling
  70                       ))
  71
  72 renameModule us this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
  73   =     -- Initialise the renamer monad
  74     initRn mod_name us (mkSearchPath opt_HiMap) loc
  75            (rename this_mod)                            >>=
  76         \ ((maybe_rn_stuff, dump_action), rn_errs_bag, rn_warns_bag) ->
  77
  78         -- Check for warnings
  79     printErrorsAndWarnings rn_errs_bag rn_warns_bag     >>
  80
  81         -- Dump any debugging output
  82     dump_action                                         >>
  83
  84         -- Return results
  85     if not (isEmptyBag rn_errs_bag) then
  86             ghcExit 1 >> return Nothing
  87     else
  88             return maybe_rn_stuff
  89 \end{code}
  90
  91
  92 \begin{code}
  93 rename this_mod@(HsModule mod_name vers _ imports local_decls mod_deprec loc)
  94   =     -- FIND THE GLOBAL NAME ENVIRONMENT
  95     getGlobalNames this_mod                     `thenRn` \ maybe_stuff ->
  96
  97         -- CHECK FOR EARLY EXIT
  98     if not (maybeToBool maybe_stuff) then
  99         -- Everything is up to date; no need to recompile further
 100         rnDump [] []            `thenRn` \ dump_action ->
 101         returnRn (Nothing, dump_action)
 102     else
 103     let
 104         Just (export_env, gbl_env, fixity_env, global_avail_env) = maybe_stuff
 105     in
 106
 107         -- RENAME THE SOURCE
 108     initRnMS gbl_env fixity_env SourceMode (
 109         rnSourceDecls local_decls
 110     )                                   `thenRn` \ (rn_local_decls, source_fvs) ->
 111
 112         -- SLURP IN ALL THE NEEDED DECLARATIONS
 113     implicitFVs mod_name rn_local_decls         `thenRn` \ implicit_fvs ->
 114     let
 115         real_source_fvs = implicit_fvs `plusFV` source_fvs
 116                 -- It's important to do the "plus" this way round, so that
 117                 -- when compiling the prelude, locally-defined (), Bool, etc
 118                 -- override the implicit ones.
 119     in
 120     slurpImpDecls real_source_fvs       `thenRn` \ rn_imp_decls ->
 121     let
 122         rn_all_decls       = rn_local_decls ++ rn_imp_decls
 123
 124         -- COLLECT ALL DEPRECATIONS
 125         deprec_sigs = [ ds | ValD bnds <- rn_local_decls, ds <- collectDeprecs bnds ]
 126
 127         (rn_mod_deprec, deprecs) = case mod_deprec of
 128            Nothing -> (Nothing, deprec_sigs)
 129            Just (DeprecMod t) -> let dm = DeprecMod t in (Just dm, dm:deprec_sigs)
 130
 131         collectDeprecs EmptyBinds = []
 132         collectDeprecs (ThenBinds x y) = collectDeprecs x ++ collectDeprecs y
 133         collectDeprecs (MonoBind _ sigs _) = [ d | DeprecSig d _ <- sigs ]
 134     in
 135
 136         -- EXIT IF ERRORS FOUND
 137     checkErrsRn                                 `thenRn` \ no_errs_so_far ->
 138     if not no_errs_so_far then
 139         -- Found errors already, so exit now
 140         rnDump rn_imp_decls rn_all_decls        `thenRn` \ dump_action ->
 141         returnRn (Nothing, dump_action)
 142     else
 143
 144         -- GENERATE THE VERSION/USAGE INFO
 145     getImportVersions mod_name export_env       `thenRn` \ my_usages ->
 146     getNameSupplyRn                             `thenRn` \ name_supply ->
 147
 148         -- REPORT UNUSED NAMES
 149     reportUnusedNames gbl_env global_avail_env
 150                       export_env
 151                       source_fvs                        `thenRn_`
 152
 153         -- RETURN THE RENAMED MODULE
 154     let
 155         has_orphans        = any isOrphanDecl rn_local_decls
 156         direct_import_mods = [mod | ImportDecl mod _ _ _ _ _ <- imports]
 157         renamed_module = HsModule mod_name vers
 158                                   trashed_exports trashed_imports
 159                                   rn_all_decls
 160                                   rn_mod_deprec
 161                                   loc
 162     in
 163     rnDump rn_imp_decls rn_all_decls            `thenRn` \ dump_action ->
 164     returnRn (Just (mkThisModule mod_name,
 165                     renamed_module,
 166                     (InterfaceDetails has_orphans my_usages export_env deprecs),
 167                     name_supply,
 168                     direct_import_mods), dump_action)
 169   where
 170     trashed_exports  = {-trace "rnSource:trashed_exports"-} Nothing
 171     trashed_imports  = {-trace "rnSource:trashed_imports"-} []
 172 \end{code}
 173
 174 @implicitFVs@ forces the renamer to slurp in some things which aren't
 175 mentioned explicitly, but which might be needed by the type checker.
 176
 177 \begin{code}
 178 implicitFVs mod_name decls
 179   = mapRn lookupImplicitOccRn implicit_occs     `thenRn` \ implicit_names ->
 180     returnRn (implicit_main                             `plusFV`
 181               mkNameSet (map getName default_tycons)    `plusFV`
 182               mkNameSet thinAirIdNames                  `plusFV`
 183               mkNameSet implicit_names)
 184   where
 185         -- Add occurrences for Int, and (), because they
 186         -- are the types to which ambigious type variables may be defaulted by
 187         -- the type checker; so they won't always appear explicitly.
 188         -- [The () one is a GHC extension for defaulting CCall results.]
 189         -- ALSO: funTyCon, since it occurs implicitly everywhere!
 190         --       (we don't want to be bothered with making funTyCon a
 191         --        free var at every function application!)
 192         -- Double is dealt with separately in getGates
 193     default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
 194
 195         -- Add occurrences for IO or PrimIO
 196     implicit_main |  mod_name == mAIN_Name
 197                   || mod_name == pREL_MAIN_Name = unitFV ioTyCon_NAME
 198                   |  otherwise                  = emptyFVs
 199
 200         -- Now add extra "occurrences" for things that
 201         -- the deriving mechanism, or defaulting, will later need in order to
 202         -- generate code
 203     implicit_occs = foldr ((++) . get) [] decls
 204
 205     get (TyClD (TyData _ _ _ _ _ (Just deriv_classes) _ _))
 206        = concat (map get_deriv deriv_classes)
 207     get other = []
 208
 209     get_deriv cls = case lookupUFM derivingOccurrences cls of
 210                         Nothing   -> []
 211                         Just occs -> occs
 212 \end{code}
 213
 214 \begin{code}
 215 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
 216   = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
 217         -- The 'removeContext' is because of
 218         --      instance Foo a => Baz T where ...
 219         -- The decl is an orphan if Baz and T are both not locally defined,
 220         --      even if Foo *is* locally defined
 221
 222 isOrphanDecl (RuleD (RuleDecl _ _ _ lhs _ _))
 223   = check lhs
 224   where
 225         -- At the moment we just check for common LHS forms
 226         -- Expand as necessary.  Getting it wrong just means
 227         -- more orphans than necessary
 228     check (HsVar v)       = not (isLocallyDefined v)
 229     check (HsApp f a)     = check f && check a
 230     check (HsLit _)       = False
 231     check (OpApp l o _ r) = check l && check o && check r
 232     check (NegApp e _)    = check e
 233     check (HsPar e)       = check e
 234     check (SectionL e o)  = check e && check o
 235     check (SectionR o e)  = check e && check o
 236
 237     check other           = True        -- Safe fall through
 238
 239 isOrphanDecl other = False
 240 \end{code}
 241
 242
 243 \begin{code}
 244 dupDefaultDeclErrRn (DefaultDecl _ locn1 : dup_things)
 245   = pushSrcLocRn locn1  $
 246     addErrRn msg
 247   where
 248     msg = hang (ptext SLIT("Multiple default declarations"))
 249                4  (vcat (map pp dup_things))
 250     pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
 251 \end{code}
 252
 253
 254 %*********************************************************
 255 %*                                                       *
 256 \subsection{Slurping declarations}
 257 %*                                                       *
 258 %*********************************************************
 259
 260 \begin{code}
 261 -------------------------------------------------------
 262 slurpImpDecls source_fvs
 263   = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
 264
 265         -- The current slurped-set records all local things
 266     getSlurped                                  `thenRn` \ source_binders ->
 267     slurpSourceRefs source_binders source_fvs   `thenRn` \ (decls, needed) ->
 268
 269         -- And finally get everything else
 270     closeDecls decls needed
 271
 272 -------------------------------------------------------
 273 slurpSourceRefs :: NameSet                      -- Variables defined in source
 274                 -> FreeVars                     -- Variables referenced in source
 275                 -> RnMG ([RenamedHsDecl],
 276                          FreeVars)              -- Un-satisfied needs
 277 -- The declaration (and hence home module) of each gate has
 278 -- already been loaded
 279
 280 slurpSourceRefs source_binders source_fvs
 281   = go_outer []                         -- Accumulating decls
 282              emptyFVs                   -- Unsatisfied needs
 283              emptyFVs                   -- Accumulating gates
 284              (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
 285   where
 286         -- The outer loop repeatedly slurps the decls for the current gates
 287         -- and the instance decls
 288
 289         -- The outer loop is needed because consider
 290         --      instance Foo a => Baz (Maybe a) where ...
 291         -- It may be that @Baz@ and @Maybe@ are used in the source module,
 292         -- but not @Foo@; so we need to chase @Foo@ too.
 293         --
 294         -- We also need to follow superclass refs.  In particular, 'chasing @Foo@' must
 295         -- include actually getting in Foo's class decl
 296         --      class Wib a => Foo a where ..
 297         -- so that its superclasses are discovered.  The point is that Wib is a gate too.
 298         -- We do this for tycons too, so that we look through type synonyms.
 299
 300     go_outer decls fvs all_gates []
 301         = returnRn (decls, fvs)
 302
 303     go_outer decls fvs all_gates refs   -- refs are not necessarily slurped yet
 304         = traceRn (text "go_outer" <+> ppr refs)                `thenRn_`
 305           go_inner decls fvs emptyFVs refs                      `thenRn` \ (decls1, fvs1, gates1) ->
 306           getImportedInstDecls (all_gates `plusFV` gates1)      `thenRn` \ inst_decls ->
 307           rnInstDecls decls1 fvs1 gates1 inst_decls             `thenRn` \ (decls2, fvs2, gates2) ->
 308           go_outer decls2 fvs2 (all_gates `plusFV` gates2)
 309                                (nameSetToList (gates2 `minusNameSet` all_gates))
 310                 -- Knock out the all_gates because even if we don't slurp any new
 311                 -- decls we can get some apparently-new gates from wired-in names
 312
 313     go_inner decls fvs gates []
 314         = returnRn (decls, fvs, gates)
 315
 316     go_inner decls fvs gates (wanted_name:refs)
 317         | isWiredInName wanted_name
 318         = load_home wanted_name         `thenRn_`
 319           go_inner decls fvs (gates `plusFV` getWiredInGates wanted_name) refs
 320
 321         | otherwise
 322         = importDecl wanted_name                `thenRn` \ maybe_decl ->
 323           case maybe_decl of
 324             Nothing   -> go_inner decls fvs gates refs  -- No declaration... (already slurped, or local)
 325             Just decl -> rnIfaceDecl decl               `thenRn` \ (new_decl, fvs1) ->
 326                          go_inner (new_decl : decls)
 327                                   (fvs1 `plusFV` fvs)
 328                                   (gates `plusFV` getGates source_fvs new_decl)
 329                                   refs
 330
 331         -- When we find a wired-in name we must load its
 332         -- home module so that we find any instance decls therein
 333     load_home name
 334         | name `elemNameSet` source_binders = returnRn ()
 335                 -- When compiling the prelude, a wired-in thing may
 336                 -- be defined in this module, in which case we don't
 337                 -- want to load its home module!
 338                 -- Using 'isLocallyDefined' doesn't work because some of
 339                 -- the free variables returned are simply 'listTyCon_Name',
 340                 -- with a system provenance.  We could look them up every time
 341                 -- but that seems a waste.
 342         | otherwise                           = loadHomeInterface doc name      `thenRn_`
 343                                                 returnRn ()
 344         where
 345           doc = ptext SLIT("need home module for wired in thing") <+> ppr name
 346
 347 rnInstDecls decls fvs gates []
 348   = returnRn (decls, fvs, gates)
 349 rnInstDecls decls fvs gates (d:ds)
 350   = rnIfaceDecl d               `thenRn` \ (new_decl, fvs1) ->
 351     rnInstDecls (new_decl:decls)
 352                 (fvs1 `plusFV` fvs)
 353                 (gates `plusFV` getInstDeclGates new_decl)
 354                 ds
 355 \end{code}
 356
 357
 358 \begin{code}
 359 -------------------------------------------------------
 360 -- closeDecls keeps going until the free-var set is empty
 361 closeDecls decls needed
 362   | not (isEmptyFVs needed)
 363   = slurpDecls decls needed     `thenRn` \ (decls1, needed1) ->
 364     closeDecls decls1 needed1
 365
 366   | otherwise
 367   = getImportedRules                    `thenRn` \ rule_decls ->
 368     case rule_decls of
 369         []    -> returnRn decls -- No new rules, so we are done
 370         other -> rnIfaceDecls decls emptyFVs rule_decls         `thenRn` \ (decls1, needed1) ->
 371                  closeDecls decls1 needed1
 372
 373
 374 -------------------------------------------------------
 375 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
 376              -> [(Module, RdrNameHsDecl)]
 377              -> RnM d ([RenamedHsDecl], FreeVars)
 378 rnIfaceDecls decls fvs []     = returnRn (decls, fvs)
 379 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d           `thenRn` \ (new_decl, fvs1) ->
 380                                 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
 381
 382 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
 383
 384
 385 -------------------------------------------------------
 386 -- Augment decls with any decls needed by needed.
 387 -- Return also free vars of the new decls (only)
 388 slurpDecls decls needed
 389   = go decls emptyFVs (nameSetToList needed)
 390   where
 391     go decls fvs []         = returnRn (decls, fvs)
 392     go decls fvs (ref:refs) = slurpDecl decls fvs ref   `thenRn` \ (decls1, fvs1) ->
 393                               go decls1 fvs1 refs
 394
 395 -------------------------------------------------------
 396 slurpDecl decls fvs wanted_name
 397   = importDecl wanted_name              `thenRn` \ maybe_decl ->
 398     case maybe_decl of
 399         -- No declaration... (wired in thing)
 400         Nothing -> returnRn (decls, fvs)
 401
 402         -- Found a declaration... rename it
 403         Just decl -> rnIfaceDecl decl           `thenRn` \ (new_decl, fvs1) ->
 404                      returnRn (new_decl:decls, fvs1 `plusFV` fvs)
 405 \end{code}
 406
 407
 408 %*********************************************************
 409 %*                                                       *
 410 \subsection{Extracting the `gates'}
 411 %*                                                       *
 412 %*********************************************************
 413
 414 When we import a declaration like
 415 \begin{verbatim}
 416         data T = T1 Wibble | T2 Wobble
 417 \end{verbatim}
 418 we don't want to treat @Wibble@ and @Wobble@ as gates
 419 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
 420 If only @T@ is mentioned
 421 we want only @T@ to be a gate;
 422 that way we don't suck in useless instance
 423 decls for (say) @Eq Wibble@, when they can't possibly be useful.
 424
 425 @getGates@ takes a newly imported (and renamed) decl, and the free
 426 vars of the source program, and extracts from the decl the gate names.
 427
 428 \begin{code}
 429 getGates source_fvs (SigD (IfaceSig _ ty _ _))
 430   = extractHsTyNames ty
 431
 432 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ _ _))
 433   = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
 434                        (map getTyVarName tvs)
 435      `addOneToNameSet` cls)
 436     `plusFV` maybe_double
 437   where
 438     get (ClassOpSig n _ _ ty _)
 439         | n `elemNameSet` source_fvs = extractHsTyNames ty
 440         | otherwise                  = emptyFVs
 441
 442         -- If we load any numeric class that doesn't have
 443         -- Int as an instance, add Double to the gates.
 444         -- This takes account of the fact that Double might be needed for
 445         -- defaulting, but we don't want to load Double (and all its baggage)
 446         -- if the more exotic classes aren't used at all.
 447     maybe_double | nameUnique cls `elem` fractionalClassKeys
 448                  = unitFV (getName doubleTyCon)
 449                  | otherwise
 450                  = emptyFVs
 451
 452 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
 453   = delListFromNameSet (extractHsTyNames ty)
 454                        (map getTyVarName tvs)
 455         -- A type synonym type constructor isn't a "gate" for instance decls
 456
 457 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _))
 458   = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
 459                        (map getTyVarName tvs)
 460     `addOneToNameSet` tycon
 461   where
 462     get (ConDecl n tvs ctxt details _)
 463         | n `elemNameSet` source_fvs
 464                 -- If the constructor is method, get fvs from all its fields
 465         = delListFromNameSet (get_details details `plusFV`
 466                               extractHsCtxtTyNames ctxt)
 467                              (map getTyVarName tvs)
 468     get (ConDecl n tvs ctxt (RecCon fields) _)
 469                 -- Even if the constructor isn't mentioned, the fields
 470                 -- might be, as selectors.  They can't mention existentially
 471                 -- bound tyvars (typechecker checks for that) so no need for
 472                 -- the deleteListFromNameSet part
 473         = foldr (plusFV . get_field) emptyFVs fields
 474
 475     get other_con = emptyFVs
 476
 477     get_details (VanillaCon tys) = plusFVs (map get_bang tys)
 478     get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
 479     get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
 480     get_details (NewCon t _)     = extractHsTyNames t
 481
 482     get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
 483                      | otherwise                         = emptyFVs
 484
 485     get_bang (Banged   t) = extractHsTyNames t
 486     get_bang (Unbanged t) = extractHsTyNames t
 487     get_bang (Unpacked t) = extractHsTyNames t
 488
 489 getGates source_fvs other_decl = emptyFVs
 490 \end{code}
 491
 492 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
 493 rather than a declaration.
 494
 495 \begin{code}
 496 getWiredInGates :: Name -> FreeVars
 497 getWiredInGates name    -- No classes are wired in
 498   | is_id                = getWiredInGates_s (namesOfType (idType the_id))
 499   | isSynTyCon the_tycon = getWiredInGates_s
 500          (delListFromNameSet (namesOfType ty) (map getName tyvars))
 501   | otherwise            = unitFV name
 502   where
 503     maybe_wired_in_id    = maybeWiredInIdName name
 504     is_id                = maybeToBool maybe_wired_in_id
 505     maybe_wired_in_tycon = maybeWiredInTyConName name
 506     Just the_id          = maybe_wired_in_id
 507     Just the_tycon       = maybe_wired_in_tycon
 508     (tyvars,ty)          = getSynTyConDefn the_tycon
 509
 510 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
 511 \end{code}
 512
 513 \begin{code}
 514 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
 515 getInstDeclGates other                              = emptyFVs
 516 \end{code}
 517
 518
 519 %*********************************************************
 520 %*                                                       *
 521 \subsection{Unused names}
 522 %*                                                       *
 523 %*********************************************************
 524
 525 \begin{code}
 526 reportUnusedNames gbl_env avail_env (ExportEnv export_avails _ _) mentioned_names
 527   = let
 528         used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
 529
 530         -- Now, a use of C implies a use of T,
 531         -- if C was brought into scope by T(..) or T(C)
 532         really_used_names = used_names `unionNameSets`
 533           mkNameSet [ availName avail
 534                     | sub_name <- nameSetToList used_names,
 535                       let avail = case lookupNameEnv avail_env sub_name of
 536                             Just avail -> avail
 537                             Nothing -> WARN( True, text "reportUnusedName: not in avail_env" <+> ppr sub_name )
 538                                        Avail sub_name
 539                     ]
 540
 541         defined_names = mkNameSet (concat (rdrEnvElts gbl_env))
 542         defined_but_not_used =
 543            nameSetToList (defined_names `minusNameSet` really_used_names)
 544
 545         -- Filter out the ones only defined implicitly
 546         bad_locals = [n | n <- defined_but_not_used, isLocallyDefined             n]
 547         bad_imps   = [n | n <- defined_but_not_used, isUserImportedExplicitlyName n]
 548     in
 549     warnUnusedLocalBinds bad_locals     `thenRn_`
 550     warnUnusedImports bad_imps
 551
 552 rnDump  :: [RenamedHsDecl]      -- Renamed imported decls
 553         -> [RenamedHsDecl]      -- Renamed local decls
 554         -> RnMG (IO ())
 555 rnDump imp_decls decls
 556         | opt_D_dump_rn_trace ||
 557           opt_D_dump_rn_stats ||
 558           opt_D_dump_rn
 559         = getRnStats imp_decls          `thenRn` \ stats_msg ->
 560
 561           returnRn (printErrs stats_msg >>
 562                     dumpIfSet opt_D_dump_rn "Renamer:" (vcat (map ppr decls)))
 563
 564         | otherwise = returnRn (return ())
 565 \end{code}
 566
 567
 568 %*********************************************************
 569 %*                                                      *
 570 \subsection{Statistics}
 571 %*                                                      *
 572 %*********************************************************
 573
 574 \begin{code}
 575 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
 576 getRnStats imported_decls
 577   = getIfacesRn                 `thenRn` \ ifaces ->
 578     let
 579         n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
 580
 581         decls_read     = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
 582                                 -- Data, newtype, and class decls are in the decls_fm
 583                                 -- under multiple names; the tycon/class, and each
 584                                 -- constructor/class op too.
 585                                 -- The 'True' selects just the 'main' decl
 586                                  not (isLocallyDefined (availName avail))
 587                              ]
 588
 589         (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd,     _) = count_decls decls_read
 590         (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
 591
 592         unslurped_insts       = iInsts ifaces
 593         inst_decls_unslurped  = length (bagToList unslurped_insts)
 594         inst_decls_read       = id_sp + inst_decls_unslurped
 595
 596         stats = vcat
 597                 [int n_mods <+> text "interfaces read",
 598                  hsep [ int cd_sp, text "class decls imported, out of",
 599                         int cd_rd, text "read"],
 600                  hsep [ int dd_sp, text "data decls imported, out of",
 601                         int dd_rd, text "read"],
 602                  hsep [ int nd_sp, text "newtype decls imported, out of",
 603                         int nd_rd, text "read"],
 604                  hsep [int sd_sp, text "type synonym decls imported, out of",
 605                         int sd_rd, text "read"],
 606                  hsep [int vd_sp, text "value signatures imported, out of",
 607                         int vd_rd, text "read"],
 608                  hsep [int id_sp, text "instance decls imported, out of",
 609                         int inst_decls_read, text "read"],
 610                  text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
 611                                            [d | TyClD d <- imported_decls, isClassDecl d]),
 612                  text "cls dcls read"  <+> fsep (map (ppr . tyClDeclName)
 613                                            [d | TyClD d <- decls_read, isClassDecl d])]
 614     in
 615     returnRn (hcat [text "Renamer stats: ", stats])
 616
 617 count_decls decls
 618   = (class_decls,
 619      data_decls,
 620      newtype_decls,
 621      syn_decls,
 622      val_decls,
 623      inst_decls)
 624   where
 625     tycl_decls = [d | TyClD d <- decls]
 626     (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
 627
 628     val_decls     = length [() | SigD _   <- decls]
 629     inst_decls    = length [() | InstD _  <- decls]
 630 \end{code}
 631