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