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