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