ghc/compiler/rename/Rename.lhs

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