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