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