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