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