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