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, closeIfaceDecls ) where
   8
   9 #include "HsVersions.h"
  10
  11 import HsSyn
  12 import RdrHsSyn         ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
  13                           RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl
  14                         )
  15 import RnHsSyn          ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
  16                           extractHsTyNames,
  17                           instDeclFVs, tyClDeclFVs, ruleDeclFVs
  18                         )
  19
  20 import CmdLineOpts      ( DynFlags, DynFlag(..) )
  21 import RnMonad
  22 import RnNames          ( getGlobalNames )
  23 import RnSource         ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
  24 import RnIfaces         ( slurpImpDecls, mkImportInfo,
  25                           getInterfaceExports, closeDecls,
  26                           RecompileRequired, recompileRequired
  27                         )
  28 import RnHiFiles        ( findAndReadIface, removeContext, loadExports, loadFixDecls, loadDeprecs )
  29 import RnEnv            ( availName, availsToNameSet,
  30                           emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, sortAvails,
  31                           warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
  32                           lookupOrigNames, lookupGlobalRn, newGlobalName
  33                         )
  34 import Module           ( Module, ModuleName, WhereFrom(..),
  35                           moduleNameUserString, moduleName,
  36                           lookupModuleEnv
  37                         )
  38 import Name             ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
  39                           nameOccName, nameModule,
  40                           mkNameEnv, nameEnvElts, extendNameEnv
  41                         )
  42 import OccName          ( occNameFlavour )
  43 import NameSet
  44 import TysWiredIn       ( unitTyCon, intTyCon, boolTyCon )
  45 import PrelNames        ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
  46                           ioTyCon_RDR,
  47                           unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
  48                           eqString_RDR
  49                         )
  50 import PrelInfo         ( derivingOccurrences )
  51 import Type             ( funTyCon )
  52 import ErrUtils         ( dumpIfSet )
  53 import Bag              ( bagToList )
  54 import FiniteMap        ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
  55                           addToFM_C, elemFM, addToFM
  56                         )
  57 import UniqFM           ( lookupUFM )
  58 import Maybes           ( maybeToBool, catMaybes )
  59 import Outputable
  60 import IO               ( openFile, IOMode(..) )
  61 import HscTypes         ( Finder, PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
  62                           ModIface(..), WhatsImported(..),
  63                           VersionInfo(..), ImportVersion, IfaceDecls(..),
  64                           GlobalRdrEnv, AvailEnv, Avails, GenAvailInfo(..), AvailInfo,
  65                           Provenance(..), ImportReason(..), initialVersionInfo,
  66                           Deprecations(..), lookupDeprec
  67                          )
  68 import List             ( partition, nub )
  69 \end{code}
  70
  71
  72
  73 %*********************************************************
  74 %*                                                       *
  75 \subsection{The main function: rename}
  76 %*                                                       *
  77 %*********************************************************
  78
  79 \begin{code}
  80 renameModule :: DynFlags -> Finder
  81              -> HomeIfaceTable -> HomeSymbolTable
  82              -> PersistentCompilerState
  83              -> Module -> RdrNameHsModule
  84              -> IO (PersistentCompilerState, Maybe (ModIface, [RenamedHsDecl]))
  85         -- Nothing => some error occurred in the renamer
  86
  87 renameModule dflags finder hit hst old_pcs this_module rdr_module
  88   =     -- Initialise the renamer monad
  89     do {
  90         (new_pcs, errors_found, maybe_rn_stuff)
  91            <- initRn dflags finder hit hst old_pcs this_module (rename this_module rdr_module) ;
  92
  93         -- Return results.  No harm in updating the PCS
  94         if errors_found then
  95             return (new_pcs, Nothing)
  96         else
  97             return (new_pcs, maybe_rn_stuff)
  98     }
  99 \end{code}
 100
 101 \begin{code}
 102 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (ModIface, [RenamedHsDecl]))
 103 rename this_module this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
 104   =     -- FIND THE GLOBAL NAME ENVIRONMENT
 105     getGlobalNames this_mod                     `thenRn` \ maybe_stuff ->
 106
 107         -- CHECK FOR EARLY EXIT
 108     case maybe_stuff of {
 109         Nothing ->      -- Everything is up to date; no need to recompile further
 110                 rnDump [] []            `thenRn_`
 111                 returnRn Nothing ;
 112
 113         Just (gbl_env, local_gbl_env, export_avails, global_avail_env) ->
 114
 115         -- DEAL WITH DEPRECATIONS
 116     rnDeprecs local_gbl_env mod_deprec
 117               [d | DeprecD d <- local_decls]            `thenRn` \ my_deprecs ->
 118
 119         -- DEAL WITH LOCAL FIXITIES
 120     fixitiesFromLocalDecls local_gbl_env local_decls    `thenRn` \ local_fixity_env ->
 121
 122         -- RENAME THE SOURCE
 123     initRnMS gbl_env local_fixity_env SourceMode (
 124         rnSourceDecls local_decls
 125     )                                   `thenRn` \ (rn_local_decls, source_fvs) ->
 126
 127         -- SLURP IN ALL THE NEEDED DECLARATIONS
 128     implicitFVs mod_name rn_local_decls         `thenRn` \ implicit_fvs ->
 129     let
 130                 -- The export_fvs make the exported names look just as if they
 131                 -- occurred in the source program.  For the reasoning, see the
 132                 -- comments with RnIfaces.getImportVersions.
 133                 -- We only need the 'parent name' of the avail;
 134                 -- that's enough to suck in the declaration.
 135         export_fvs      = mkNameSet (map availName export_avails)
 136         real_source_fvs = source_fvs `plusFV` export_fvs
 137
 138         slurp_fvs       = implicit_fvs `plusFV` real_source_fvs
 139                 -- It's important to do the "plus" this way round, so that
 140                 -- when compiling the prelude, locally-defined (), Bool, etc
 141                 -- override the implicit ones.
 142     in
 143     slurpImpDecls slurp_fvs             `thenRn` \ rn_imp_decls ->
 144
 145         -- EXIT IF ERRORS FOUND
 146     rnDump rn_imp_decls rn_local_decls          `thenRn_`
 147     checkErrsRn                                 `thenRn` \ no_errs_so_far ->
 148     if not no_errs_so_far then
 149         -- Found errors already, so exit now
 150         returnRn Nothing
 151     else
 152
 153         -- GENERATE THE VERSION/USAGE INFO
 154     mkImportInfo mod_name imports       `thenRn` \ my_usages ->
 155
 156         -- RETURN THE RENAMED MODULE
 157     getNameSupplyRn                     `thenRn` \ name_supply ->
 158     getIfacesRn                         `thenRn` \ ifaces ->
 159     let
 160         direct_import_mods :: [ModuleName]
 161         direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
 162
 163         -- We record fixities even for things that aren't exported,
 164         -- so that we can change into the context of this moodule easily
 165         fixities = mkNameEnv [ (name, fixity)
 166                              | FixitySig name fixity loc <- nameEnvElts local_fixity_env
 167                              ]
 168
 169
 170         -- Sort the exports to make them easier to compare for versions
 171         my_exports = sortAvails export_avails
 172
 173         mod_iface = ModIface {  mi_module   = this_module,
 174                                 mi_version  = initialVersionInfo,
 175                                 mi_orphan   = any isOrphanDecl rn_local_decls,
 176                                 mi_exports  = my_exports,
 177                                 mi_globals  = gbl_env,
 178                                 mi_usages   = my_usages,
 179                                 mi_fixities = fixities,
 180                                 mi_deprecs  = my_deprecs,
 181                                 mi_decls    = panic "mi_decls"
 182                     }
 183
 184         final_decls = rn_local_decls ++ rn_imp_decls
 185     in
 186
 187         -- REPORT UNUSED NAMES, AND DEBUG DUMP
 188     reportUnusedNames mod_name direct_import_mods
 189                       gbl_env global_avail_env
 190                       export_avails source_fvs
 191                       rn_imp_decls                      `thenRn_`
 192
 193     returnRn (Just (mod_iface, final_decls))
 194     }
 195 \end{code}
 196
 197 @implicitFVs@ forces the renamer to slurp in some things which aren't
 198 mentioned explicitly, but which might be needed by the type checker.
 199
 200 \begin{code}
 201 implicitFVs mod_name decls
 202   = lookupOrigNames implicit_occs                       `thenRn` \ implicit_names ->
 203     returnRn (mkNameSet (map getName default_tycons)    `plusFV`
 204               implicit_names)
 205   where
 206         -- Add occurrences for Int, and (), because they
 207         -- are the types to which ambigious type variables may be defaulted by
 208         -- the type checker; so they won't always appear explicitly.
 209         -- [The () one is a GHC extension for defaulting CCall results.]
 210         -- ALSO: funTyCon, since it occurs implicitly everywhere!
 211         --       (we don't want to be bothered with making funTyCon a
 212         --        free var at every function application!)
 213         -- Double is dealt with separately in getGates
 214     default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
 215
 216         -- Add occurrences for IO or PrimIO
 217     implicit_main |  mod_name == mAIN_Name
 218                   || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
 219                   |  otherwise                  = []
 220
 221         -- Now add extra "occurrences" for things that
 222         -- the deriving mechanism, or defaulting, will later need in order to
 223         -- generate code
 224     implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
 225
 226         -- Virtually every program has error messages in it somewhere
 227     string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
 228                    eqString_RDR]
 229
 230     get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
 231        = concat (map get_deriv deriv_classes)
 232     get other = []
 233
 234     get_deriv cls = case lookupUFM derivingOccurrences cls of
 235                         Nothing   -> []
 236                         Just occs -> occs
 237 \end{code}
 238
 239 \begin{code}
 240 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
 241   = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
 242         -- The 'removeContext' is because of
 243         --      instance Foo a => Baz T where ...
 244         -- The decl is an orphan if Baz and T are both not locally defined,
 245         --      even if Foo *is* locally defined
 246
 247 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
 248   = check lhs
 249   where
 250         -- At the moment we just check for common LHS forms
 251         -- Expand as necessary.  Getting it wrong just means
 252         -- more orphans than necessary
 253     check (HsVar v)       = not (isLocallyDefined v)
 254     check (HsApp f a)     = check f && check a
 255     check (HsLit _)       = False
 256     check (HsOverLit _)   = False
 257     check (OpApp l o _ r) = check l && check o && check r
 258     check (NegApp e _)    = check e
 259     check (HsPar e)       = check e
 260     check (SectionL e o)  = check e && check o
 261     check (SectionR o e)  = check e && check o
 262
 263     check other           = True        -- Safe fall through
 264
 265 isOrphanDecl other = False
 266 \end{code}
 267
 268
 269 %*********************************************************
 270 %*                                                       *
 271 \subsection{Fixities}
 272 %*                                                       *
 273 %*********************************************************
 274
 275 \begin{code}
 276 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
 277 fixitiesFromLocalDecls gbl_env decls
 278   = doptRn Opt_WarnUnusedBinds                            `thenRn` \ warn_unused ->
 279     foldlRn (getFixities warn_unused) emptyNameEnv decls  `thenRn` \ env ->
 280     traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))
 281                                                           `thenRn_`
 282     returnRn env
 283   where
 284     getFixities :: Bool -> LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
 285     getFixities warn_uu acc (FixD fix)
 286       = fix_decl warn_uu acc fix
 287
 288     getFixities warn_uu acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
 289       = foldlRn (fix_decl warn_uu) acc [sig | FixSig sig <- sigs]
 290                 -- Get fixities from class decl sigs too.
 291     getFixities warn_uu acc other_decl
 292       = returnRn acc
 293
 294     fix_decl warn_uu acc sig@(FixitySig rdr_name fixity loc)
 295         =       -- Check for fixity decl for something not declared
 296           pushSrcLocRn loc                      $
 297           lookupGlobalRn gbl_env rdr_name       `thenRn` \  maybe_name ->
 298           case maybe_name of {
 299             Nothing ->  checkRn (not warn_uu) (unusedFixityDecl rdr_name fixity)        `thenRn_`
 300                         returnRn acc ;
 301
 302             Just name ->
 303
 304                 -- Check for duplicate fixity decl
 305           case lookupNameEnv acc name of {
 306             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
 307                                          `thenRn_` returnRn acc ;
 308
 309             Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
 310           }}
 311 \end{code}
 312
 313
 314 %*********************************************************
 315 %*                                                       *
 316 \subsection{Deprecations}
 317 %*                                                       *
 318 %*********************************************************
 319
 320 For deprecations, all we do is check that the names are in scope.
 321 It's only imported deprecations, dealt with in RnIfaces, that we
 322 gather them together.
 323
 324 \begin{code}
 325 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
 326            -> [RdrNameDeprecation] -> RnMG Deprecations
 327 rnDeprecs gbl_env Nothing []
 328  = returnRn NoDeprecs
 329
 330 rnDeprecs gbl_env (Just txt) decls
 331  = mapRn (addErrRn . badDeprec) decls   `thenRn_`
 332    returnRn (DeprecAll txt)
 333
 334 rnDeprecs gbl_env Nothing decls
 335   = mapRn rn_deprec decls       `thenRn` \ pairs ->
 336     returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
 337  where
 338    rn_deprec (Deprecation rdr_name txt loc)
 339      = pushSrcLocRn loc                 $
 340        lookupGlobalRn gbl_env rdr_name  `thenRn` \ maybe_name ->
 341        case maybe_name of
 342          Just n  -> returnRn (Just (n,txt))
 343          Nothing -> returnRn Nothing
 344 \end{code}
 345
 346
 347 %************************************************************************
 348 %*                                                                      *
 349 \subsection{Grabbing the old interface file and checking versions}
 350 %*                                                                      *
 351 %************************************************************************
 352
 353 \begin{code}
 354 checkOldIface :: DynFlags -> Finder
 355               -> HomeIfaceTable -> HomeSymbolTable
 356               -> PersistentCompilerState
 357               -> Module
 358               -> Bool                   -- Source unchanged
 359               -> Maybe ModIface         -- Old interface from compilation manager, if any
 360               -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
 361                                 -- True <=> errors happened
 362
 363 checkOldIface dflags finder hit hst pcs mod source_unchanged maybe_iface
 364   = initRn dflags finder hit hst pcs mod $
 365
 366         -- Load the old interface file, if we havn't already got it
 367     loadOldIface mod maybe_iface                        `thenRn` \ maybe_iface ->
 368
 369         -- Check versions
 370     recompileRequired mod source_unchanged maybe_iface  `thenRn` \ recompile ->
 371
 372     returnRn (recompile, maybe_iface)
 373 \end{code}
 374
 375
 376 \begin{code}
 377 loadOldIface :: Module -> Maybe ModIface -> RnMG (Maybe ModIface)
 378 loadOldIface mod (Just iface)
 379   = returnRn (Just iface)
 380
 381 loadOldIface mod Nothing
 382   =     -- LOAD THE OLD INTERFACE FILE
 383     findAndReadIface doc_str (moduleName mod) False {- Not hi-boot -}   `thenRn` \ read_result ->
 384     case read_result of {
 385         Left err ->     -- Old interface file not found, or garbled, so we'd better bail out
 386                     traceRn (vcat [ptext SLIT("No old interface file:"), err])  `thenRn_`
 387                     returnRn Nothing ;
 388
 389         Right (_, iface) ->
 390
 391         -- RENAME IT
 392     initIfaceRnMS mod (
 393         loadHomeDecls (pi_decls iface)  `thenRn` \ decls ->
 394         loadHomeRules (pi_rules iface)  `thenRn` \ rules ->
 395         loadHomeInsts (pi_insts iface)  `thenRn` \ insts ->
 396         returnRn (decls, rules, insts)
 397     )                           `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
 398
 399     mapRn loadHomeUsage (pi_usages iface)       `thenRn` \ usages ->
 400     loadExports         (pi_exports iface)      `thenRn` \ (export_vers, avails) ->
 401     loadFixDecls mod    (pi_fixity iface)       `thenRn` \ fix_env ->
 402     loadDeprecs mod     (pi_deprecs iface)      `thenRn` \ deprec_env ->
 403     let
 404         version = VersionInfo { vers_module  = pi_vers iface,
 405                                 vers_exports = export_vers,
 406                                 vers_rules   = rule_vers,
 407                                 vers_decls   = decls_vers }
 408
 409         decls = IfaceDecls { dcl_tycl = new_decls,
 410                              dcl_rules = new_rules,
 411                              dcl_insts = new_insts }
 412
 413         mod_iface = ModIface { mi_module = mod, mi_version = version,
 414                                mi_exports = avails, mi_orphan = pi_orphan iface,
 415                                mi_fixities = fix_env, mi_deprecs = deprec_env,
 416                                mi_usages  = usages,
 417                                mi_decls   = decls,
 418                                mi_globals = panic "No mi_globals in old interface"
 419                     }
 420     in
 421     returnRn (Just mod_iface)
 422     }
 423
 424
 425   where
 426     doc_str = ptext SLIT("need usage info from") <+> ppr mod
 427 \end{code}
 428
 429 \begin{code}
 430 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
 431               -> RnMS (NameEnv Version, [RenamedTyClDecl])
 432 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
 433
 434 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
 435              -> (Version, RdrNameTyClDecl)
 436              -> RnMS (NameEnv Version, [RenamedTyClDecl])
 437 loadHomeDecl (version_map, decls) (version, decl)
 438   = rnTyClDecl decl     `thenRn` \ decl' ->
 439     returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
 440
 441 ------------------
 442 loadHomeRules :: (Version, [RdrNameRuleDecl])
 443               -> RnMS (Version, [RenamedRuleDecl])
 444 loadHomeRules (version, rules)
 445   = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
 446     returnRn (version, rules')
 447
 448 ------------------
 449 loadHomeInsts :: [RdrNameInstDecl]
 450               -> RnMS [RenamedInstDecl]
 451 loadHomeInsts insts = mapRn rnInstDecl insts
 452
 453 ------------------
 454 loadHomeUsage :: ImportVersion OccName
 455               -> RnMG (ImportVersion Name)
 456 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
 457   = rn_imps whats_imported      `thenRn` \ whats_imported' ->
 458     returnRn (mod_name, orphans, is_boot, whats_imported')
 459   where
 460     rn_imps NothingAtAll                  = returnRn NothingAtAll
 461     rn_imps (Everything v)                = returnRn (Everything v)
 462     rn_imps (Specifically mv ev items rv) = mapRn rn_imp items  `thenRn` \ items' ->
 463                                             returnRn (Specifically mv ev items' rv)
 464     rn_imp (occ,vers) = newGlobalName mod_name occ      `thenRn` \ name ->
 465                         returnRn (name,vers)
 466 \end{code}
 467
 468
 469
 470 %*********************************************************
 471 %*                                                       *
 472 \subsection{Closing up the interface decls}
 473 %*                                                       *
 474 %*********************************************************
 475
 476 Suppose we discover we don't need to recompile.   Then we start from the
 477 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
 478
 479 \begin{code}
 480 closeIfaceDecls :: DynFlags -> Finder
 481                 -> HomeIfaceTable -> HomeSymbolTable
 482                 -> PersistentCompilerState
 483                 -> ModIface     -- Get the decls from here
 484                 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
 485                                 -- True <=> errors happened
 486 closeIfaceDecls dflags finder hit hst pcs
 487                 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
 488   = initRn dflags finder hit hst pcs mod $
 489
 490     let
 491         rule_decls = dcl_rules iface_decls
 492         inst_decls = dcl_insts iface_decls
 493         tycl_decls = dcl_tycl  iface_decls
 494         decls = map RuleD rule_decls ++
 495                 map InstD inst_decls ++
 496                 map TyClD tycl_decls
 497         needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
 498                  unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
 499                  unionManyNameSets (map tyClDeclFVs tycl_decls)
 500     in
 501     closeDecls decls needed
 502 \end{code}
 503
 504 %*********************************************************
 505 %*                                                       *
 506 \subsection{Unused names}
 507 %*                                                       *
 508 %*********************************************************
 509
 510 \begin{code}
 511 reportUnusedNames :: ModuleName -> [ModuleName]
 512                   -> GlobalRdrEnv -> AvailEnv
 513                   -> Avails -> NameSet -> [RenamedHsDecl]
 514                   -> RnMG ()
 515 reportUnusedNames mod_name direct_import_mods
 516                   gbl_env avail_env
 517                   export_avails mentioned_names
 518                   imported_decls
 519   = warnUnusedModules unused_imp_mods                           `thenRn_`
 520     warnUnusedLocalBinds bad_locals                             `thenRn_`
 521     warnUnusedImports bad_imp_names                             `thenRn_`
 522     printMinimalImports mod_name minimal_imports                `thenRn_`
 523     warnDeprecations really_used_names                          `thenRn_`
 524     returnRn ()
 525
 526   where
 527     used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
 528
 529     -- Now, a use of C implies a use of T,
 530     -- if C was brought into scope by T(..) or T(C)
 531     really_used_names = used_names `unionNameSets`
 532       mkNameSet [ parent_name
 533                 | sub_name <- nameSetToList used_names
 534
 535                 -- Usually, every used name will appear in avail_env, but there
 536                 -- is one time when it doesn't: tuples and other built in syntax.  When you
 537                 -- write (a,b) that gives rise to a *use* of "(,)", so that the
 538                 -- instances will get pulled in, but the tycon "(,)" isn't actually
 539                 -- in scope.  Also, (-x) gives rise to an implicit use of 'negate';
 540                 -- similarly,   3.5 gives rise to an implcit use of :%
 541                 -- Hence the silent 'False' in all other cases
 542
 543                 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
 544                                         Just (AvailTC n _) -> Just n
 545                                         other              -> Nothing]
 546             ]
 547
 548     defined_names, defined_and_used, defined_but_not_used :: [(Name,Provenance)]
 549     defined_names                            = concat (rdrEnvElts gbl_env)
 550     (defined_and_used, defined_but_not_used) = partition used defined_names
 551     used (name,_)                            = not (name `elemNameSet` really_used_names)
 552
 553     -- Filter out the ones only defined implicitly
 554     bad_locals :: [Name]
 555     bad_locals     = [n     | (n,LocalDef) <- defined_but_not_used]
 556
 557     bad_imp_names :: [(Name,Provenance)]
 558     bad_imp_names  = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True) _)) <- defined_but_not_used,
 559                               not (module_unused mod)]
 560
 561     -- inst_mods are directly-imported modules that
 562     --  contain instance decl(s) that the renamer decided to suck in
 563     -- It's not necessarily redundant to import such modules.
 564     --
 565     -- NOTE: Consider
 566     --        module This
 567     --          import M ()
 568     --
 569     --   The import M() is not *necessarily* redundant, even if
 570     --   we suck in no instance decls from M (e.g. it contains
 571     --   no instance decls, or This contains no code).  It may be
 572     --   that we import M solely to ensure that M's orphan instance
 573     --   decls (or those in its imports) are visible to people who
 574     --   import This.  Sigh.
 575     --   There's really no good way to detect this, so the error message
 576     --   in RnEnv.warnUnusedModules is weakened instead
 577     inst_mods :: [ModuleName]
 578     inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
 579                  let m = moduleName (nameModule dfun),
 580                  m `elem` direct_import_mods
 581             ]
 582
 583     -- To figure out the minimal set of imports, start with the things
 584     -- that are in scope (i.e. in gbl_env).  Then just combine them
 585     -- into a bunch of avails, so they are properly grouped
 586     minimal_imports :: FiniteMap ModuleName AvailEnv
 587     minimal_imports0 = emptyFM
 588     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
 589     minimal_imports  = foldr add_inst_mod minimal_imports1 inst_mods
 590
 591     add_name (n,NonLocalDef (UserImport m _ _) _) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
 592                                                                   (unitAvailEnv (mk_avail n))
 593     add_name (n,other_prov)                       acc = acc
 594
 595     mk_avail n = case lookupNameEnv avail_env n of
 596                 Just (AvailTC m _) | n==m      -> AvailTC n [n]
 597                                    | otherwise -> AvailTC m [n,m]
 598                 Just avail         -> Avail n
 599                 Nothing            -> pprPanic "mk_avail" (ppr n)
 600
 601     add_inst_mod m acc
 602       | m `elemFM` acc = acc    -- We import something already
 603       | otherwise      = addToFM acc m emptyAvailEnv
 604         -- Add an empty collection of imports for a module
 605         -- from which we have sucked only instance decls
 606
 607     -- unused_imp_mods are the directly-imported modules
 608     -- that are not mentioned in minimal_imports
 609     unused_imp_mods = [m | m <- direct_import_mods,
 610                        not (maybeToBool (lookupFM minimal_imports m)),
 611                        m /= pRELUDE_Name]
 612
 613     module_unused :: Module -> Bool
 614     module_unused mod = moduleName mod `elem` unused_imp_mods
 615
 616
 617 warnDeprecations used_names
 618   = doptRn Opt_WarnDeprecations                         `thenRn` \ warn_drs ->
 619     if not warn_drs then returnRn () else
 620
 621     getIfacesRn                                         `thenRn` \ ifaces ->
 622     getHomeIfaceTableRn                                 `thenRn` \ hit ->
 623     let
 624         pit     = iPIT ifaces
 625         deprecs = [ (n,txt)
 626                   | n <- nameSetToList used_names,
 627                     Just txt <- [lookup_deprec hit pit n] ]
 628     in
 629     mapRn_ warnDeprec deprecs
 630
 631   where
 632     lookup_deprec hit pit n
 633         = case lookupModuleEnv hit mod of
 634                 Just iface -> lookupDeprec iface n
 635                 Nothing    -> case lookupModuleEnv pit mod of
 636                                 Just iface -> lookupDeprec iface n
 637                                 Nothing    -> pprPanic "warnDeprecations:" (ppr n)
 638         where
 639           mod = nameModule n
 640
 641 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
 642 printMinimalImports mod_name imps
 643   = doptRn Opt_D_dump_minimal_imports           `thenRn` \ dump_minimal ->
 644     if not dump_minimal then returnRn () else
 645
 646     mapRn to_ies (fmToList imps)                `thenRn` \ mod_ies ->
 647     ioToRnM (do { h <- openFile filename WriteMode ;
 648                   printForUser h (vcat (map ppr_mod_ie mod_ies))
 649         })                                      `thenRn_`
 650     returnRn ()
 651   where
 652     filename = moduleNameUserString mod_name ++ ".imports"
 653     ppr_mod_ie (mod_name, ies)
 654         | mod_name == pRELUDE_Name
 655         = empty
 656         | otherwise
 657         = ptext SLIT("import") <+> ppr mod_name <>
 658                             parens (fsep (punctuate comma (map ppr ies)))
 659
 660     to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)      `thenRn` \ ies ->
 661                               returnRn (mod, ies)
 662
 663     to_ie :: AvailInfo -> RnMG (IE Name)
 664     to_ie (Avail n)       = returnRn (IEVar n)
 665     to_ie (AvailTC n [m]) = ASSERT( n==m )
 666                             returnRn (IEThingAbs n)
 667     to_ie (AvailTC n ns)  = getInterfaceExports (moduleName (nameModule n))
 668                                                 ImportBySystem          `thenRn` \ (_, avails) ->
 669                             case [ms | AvailTC m ms <- avails, m == n] of
 670                               [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
 671                                    | otherwise          -> returnRn (IEThingWith n (filter (/= n) ns))
 672                               other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
 673                                        returnRn (IEVar n)
 674
 675 rnDump  :: [RenamedHsDecl]      -- Renamed imported decls
 676         -> [RenamedHsDecl]      -- Renamed local decls
 677         -> RnMG ()
 678 rnDump imp_decls local_decls
 679   = doptRn Opt_D_dump_rn_trace  `thenRn` \ dump_rn_trace ->
 680     doptRn Opt_D_dump_rn_stats  `thenRn` \ dump_rn_stats ->
 681     doptRn Opt_D_dump_rn                `thenRn` \ dump_rn ->
 682     getIfacesRn                 `thenRn` \ ifaces ->
 683
 684     ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
 685                             "Renamer statistics"
 686                             (getRnStats imp_decls ifaces) ;
 687
 688                   dumpIfSet dump_rn "Renamer:"
 689                             (vcat (map ppr (local_decls ++ imp_decls)))
 690     })                          `thenRn_`
 691
 692     returnRn ()
 693 \end{code}
 694
 695
 696 %*********************************************************
 697 %*                                                      *
 698 \subsection{Statistics}
 699 %*                                                      *
 700 %*********************************************************
 701
 702 \begin{code}
 703 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
 704 getRnStats imported_decls ifaces
 705   = hcat [text "Renamer stats: ", stats]
 706   where
 707     n_mods = length [() | (_, _, True) <- eltsFM (iImpModInfo ifaces)]
 708
 709     decls_read     = [decl | (avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
 710                         -- Data, newtype, and class decls are in the decls_fm
 711                         -- under multiple names; the tycon/class, and each
 712                         -- constructor/class op too.
 713                         -- The 'True' selects just the 'main' decl
 714                          not (isLocallyDefined (availName avail))
 715                      ]
 716
 717     (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd)        = countTyClDecls decls_read
 718     (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
 719
 720     unslurped_insts       = iInsts ifaces
 721     inst_decls_unslurped  = length (bagToList unslurped_insts)
 722     inst_decls_read           = id_sp + inst_decls_unslurped
 723
 724     stats = vcat
 725         [int n_mods <+> text "interfaces read",
 726          hsep [ int cd_sp, text "class decls imported, out of",
 727                 int cd_rd, text "read"],
 728          hsep [ int dd_sp, text "data decls imported, out of",
 729                 int dd_rd, text "read"],
 730          hsep [ int nd_sp, text "newtype decls imported, out of",
 731                 int nd_rd, text "read"],
 732          hsep [int sd_sp, text "type synonym decls imported, out of",
 733                 int sd_rd, text "read"],
 734          hsep [int vd_sp, text "value signatures imported, out of",
 735                 int vd_rd, text "read"],
 736          hsep [int id_sp, text "instance decls imported, out of",
 737                 int inst_decls_read, text "read"],
 738          text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
 739                                    [d | TyClD d <- imported_decls, isClassDecl d]),
 740          text "cls dcls read"  <+> fsep (map (ppr . tyClDeclName)
 741                                            [d | d <- decls_read, isClassDecl d])]
 742
 743 count_decls decls
 744   = (class_decls,
 745      data_decls,
 746      newtype_decls,
 747      syn_decls,
 748      val_decls,
 749      inst_decls)
 750   where
 751     tycl_decls = [d | TyClD d <- decls]
 752     (class_decls, data_decls, newtype_decls, syn_decls, val_decls) = countTyClDecls tycl_decls
 753
 754     inst_decls    = length [() | InstD _  <- decls]
 755 \end{code}
 756
 757
 758 %************************************************************************
 759 %*                                                                      *
 760 \subsection{Errors and warnings}
 761 %*                                                                      *
 762 %************************************************************************
 763
 764 \begin{code}
 765 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
 766 warnDeprec (name, txt)
 767   = pushSrcLocRn (getSrcLoc name)       $
 768     addWarnRn                           $
 769     sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
 770           text "is deprecated:", nest 4 (ppr txt) ]
 771
 772
 773 unusedFixityDecl rdr_name fixity
 774   = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
 775
 776 dupFixityDecl rdr_name loc1 loc2
 777   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 778           ptext SLIT("at ") <+> ppr loc1,
 779           ptext SLIT("and") <+> ppr loc2]
 780
 781 badDeprec d
 782   = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
 783          nest 4 (ppr d)]
 784 \end{code}
 785
 786