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