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                          `thenRn_`
 527     traceRn (text "Used" <+> fsep (map ppr (nameSetToList used_names))) `thenRn_`
 528     returnRn ()
 529
 530   where
 531     this_mod   = mi_module my_mod_iface
 532     gbl_env    = mi_globals my_mod_iface
 533     my_deprecs = mi_deprecs my_mod_iface
 534
 535         -- The export_fvs make the exported names look just as if they
 536         -- occurred in the source program.
 537     export_fvs = availsToNameSet export_avails
 538     used_names = source_fvs `plusFV` export_fvs
 539
 540     -- Now, a use of C implies a use of T,
 541     -- if C was brought into scope by T(..) or T(C)
 542     really_used_names = used_names `unionNameSets`
 543       mkNameSet [ parent_name
 544                 | sub_name <- nameSetToList used_names
 545
 546                 -- Usually, every used name will appear in avail_env, but there
 547                 -- is one time when it doesn't: tuples and other built in syntax.  When you
 548                 -- write (a,b) that gives rise to a *use* of "(,)", so that the
 549                 -- instances will get pulled in, but the tycon "(,)" isn't actually
 550                 -- in scope.  Also, (-x) gives rise to an implicit use of 'negate';
 551                 -- similarly,   3.5 gives rise to an implcit use of :%
 552                 -- Hence the silent 'False' in all other cases
 553
 554                 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
 555                                         Just (AvailTC n _) -> Just n
 556                                         other              -> Nothing]
 557             ]
 558
 559         -- Collect the defined names from the in-scope environment
 560         -- Look for the qualified ones only, else get duplicates
 561     defined_names :: [(Name,Provenance)]
 562     defined_names = foldRdrEnv add [] gbl_env
 563     add rdr_name ns acc | isQual rdr_name = ns ++ acc
 564                         | otherwise       = acc
 565
 566     defined_and_used, defined_but_not_used :: [(Name,Provenance)]
 567     (defined_and_used, defined_but_not_used) = partition used defined_names
 568     used (name,_)                            = name `elemNameSet` really_used_names
 569
 570     -- Filter out the ones only defined implicitly
 571     bad_locals :: [Name]
 572     bad_locals     = [n     | (n,LocalDef) <- defined_but_not_used]
 573
 574     bad_imp_names :: [(Name,Provenance)]
 575     bad_imp_names  = [(n,p) | (n,p@(NonLocalDef (UserImport mod _ True) _)) <- defined_but_not_used,
 576                               not (module_unused mod)]
 577
 578     -- inst_mods are directly-imported modules that
 579     --  contain instance decl(s) that the renamer decided to suck in
 580     -- It's not necessarily redundant to import such modules.
 581     --
 582     -- NOTE: Consider
 583     --        module This
 584     --          import M ()
 585     --
 586     --   The import M() is not *necessarily* redundant, even if
 587     --   we suck in no instance decls from M (e.g. it contains
 588     --   no instance decls, or This contains no code).  It may be
 589     --   that we import M solely to ensure that M's orphan instance
 590     --   decls (or those in its imports) are visible to people who
 591     --   import This.  Sigh.
 592     --   There's really no good way to detect this, so the error message
 593     --   in RnEnv.warnUnusedModules is weakened instead
 594     inst_mods :: [ModuleName]
 595     inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
 596                  let m = moduleName (nameModule dfun),
 597                  m `elem` direct_import_mods
 598             ]
 599
 600     -- To figure out the minimal set of imports, start with the things
 601     -- that are in scope (i.e. in gbl_env).  Then just combine them
 602     -- into a bunch of avails, so they are properly grouped
 603     minimal_imports :: FiniteMap ModuleName AvailEnv
 604     minimal_imports0 = emptyFM
 605     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
 606     minimal_imports  = foldr add_inst_mod minimal_imports1 inst_mods
 607
 608     add_name (n,NonLocalDef (UserImport m _ _) _) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
 609                                                                   (unitAvailEnv (mk_avail n))
 610     add_name (n,other_prov)                       acc = acc
 611
 612     mk_avail n = case lookupNameEnv avail_env n of
 613                 Just (AvailTC m _) | n==m      -> AvailTC n [n]
 614                                    | otherwise -> AvailTC m [n,m]
 615                 Just avail         -> Avail n
 616                 Nothing            -> pprPanic "mk_avail" (ppr n)
 617
 618     add_inst_mod m acc
 619       | m `elemFM` acc = acc    -- We import something already
 620       | otherwise      = addToFM acc m emptyAvailEnv
 621         -- Add an empty collection of imports for a module
 622         -- from which we have sucked only instance decls
 623
 624     direct_import_mods :: [ModuleName]
 625     direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
 626
 627     -- unused_imp_mods are the directly-imported modules
 628     -- that are not mentioned in minimal_imports
 629     unused_imp_mods = [m | m <- direct_import_mods,
 630                        not (maybeToBool (lookupFM minimal_imports m)),
 631                        m /= pRELUDE_Name]
 632
 633     module_unused :: Module -> Bool
 634     module_unused mod = moduleName mod `elem` unused_imp_mods
 635
 636 warnDeprecations this_mod export_avails my_deprecs used_names
 637   = doptRn Opt_WarnDeprecations                         `thenRn` \ warn_drs ->
 638     if not warn_drs then returnRn () else
 639
 640         -- The home modules for things in the export list
 641         -- may not have been loaded yet; do it now, so
 642         -- that we can see their deprecations, if any
 643     mapRn_ load_home export_mods                `thenRn_`
 644
 645     getIfacesRn                                 `thenRn` \ ifaces ->
 646     getHomeIfaceTableRn                         `thenRn` \ hit ->
 647     let
 648         pit     = iPIT ifaces
 649         deprecs = [ (n,txt)
 650                   | n <- nameSetToList used_names,
 651                     Just txt <- [lookup_deprec hit pit n] ]
 652     in
 653     mapRn_ warnDeprec deprecs
 654
 655   where
 656     export_mods = nub [ moduleName (nameModule name)
 657                       | avail <- export_avails,
 658                         let name = availName avail,
 659                         not (nameIsLocalOrFrom this_mod name) ]
 660
 661     load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
 662
 663     lookup_deprec hit pit n
 664         | nameIsLocalOrFrom this_mod n
 665         = lookupDeprec my_deprecs n
 666         | otherwise
 667         = case lookupIface hit pit this_mod n of
 668                 Just iface -> lookupDeprec (mi_deprecs iface) n
 669                 Nothing    -> pprPanic "warnDeprecations:" (ppr n)
 670
 671 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
 672 printMinimalImports this_mod imps
 673   = doptRn Opt_D_dump_minimal_imports           `thenRn` \ dump_minimal ->
 674     if not dump_minimal then returnRn () else
 675
 676     mapRn to_ies (fmToList imps)                `thenRn` \ mod_ies ->
 677     ioToRnM (do { h <- openFile filename WriteMode ;
 678                   printForUser h (vcat (map ppr_mod_ie mod_ies))
 679         })                                      `thenRn_`
 680     returnRn ()
 681   where
 682     filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
 683     ppr_mod_ie (mod_name, ies)
 684         | mod_name == pRELUDE_Name
 685         = empty
 686         | otherwise
 687         = ptext SLIT("import") <+> ppr mod_name <>
 688                             parens (fsep (punctuate comma (map ppr ies)))
 689
 690     to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)      `thenRn` \ ies ->
 691                               returnRn (mod, ies)
 692
 693     to_ie :: AvailInfo -> RnMG (IE Name)
 694     to_ie (Avail n)       = returnRn (IEVar n)
 695     to_ie (AvailTC n [m]) = ASSERT( n==m )
 696                             returnRn (IEThingAbs n)
 697     to_ie (AvailTC n ns)
 698         = getInterfaceExports n_mod ImportBySystem              `thenRn` \ (_, avails_by_module) ->
 699           case [xs | (m,as) <- avails_by_module,
 700                      m == n_mod,
 701                      AvailTC x xs <- as,
 702                      x == n] of
 703               [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
 704                    | otherwise          -> returnRn (IEThingWith n (filter (/= n) ns))
 705               other                     -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
 706                                            returnRn (IEVar n)
 707         where
 708           n_mod = moduleName (nameModule n)
 709
 710 rnDump  :: [RenamedHsDecl]      -- Renamed imported decls
 711         -> [RenamedHsDecl]      -- Renamed local decls
 712         -> RnMG ()
 713 rnDump imp_decls local_decls
 714   = doptRn Opt_D_dump_rn_trace  `thenRn` \ dump_rn_trace ->
 715     doptRn Opt_D_dump_rn_stats  `thenRn` \ dump_rn_stats ->
 716     doptRn Opt_D_dump_rn        `thenRn` \ dump_rn ->
 717     getIfacesRn                 `thenRn` \ ifaces ->
 718
 719     ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
 720                             "Renamer statistics"
 721                             (getRnStats imp_decls ifaces) ;
 722
 723                   dumpIfSet dump_rn "Renamer:"
 724                             (vcat (map ppr (local_decls ++ imp_decls)))
 725     })                          `thenRn_`
 726
 727     returnRn ()
 728 \end{code}
 729
 730
 731 %*********************************************************
 732 %*                                                      *
 733 \subsection{Statistics}
 734 %*                                                      *
 735 %*********************************************************
 736
 737 \begin{code}
 738 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
 739 getRnStats imported_decls ifaces
 740   = hcat [text "Renamer stats: ", stats]
 741   where
 742     n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
 743         -- This is really only right for a one-shot compile
 744
 745     (decls_map, n_decls_slurped) = iDecls ifaces
 746
 747     n_decls_left   = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
 748                         -- Data, newtype, and class decls are in the decls_fm
 749                         -- under multiple names; the tycon/class, and each
 750                         -- constructor/class op too.
 751                         -- The 'True' selects just the 'main' decl
 752                      ]
 753
 754     (insts_left, n_insts_slurped) = iInsts ifaces
 755     n_insts_left  = length (bagToList insts_left)
 756
 757     (rules_left, n_rules_slurped) = iRules ifaces
 758     n_rules_left  = length (bagToList rules_left)
 759
 760     stats = vcat
 761         [int n_mods <+> text "interfaces read",
 762          hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
 763                 int (n_decls_slurped + n_decls_left), text "read"],
 764          hsep [ int n_insts_slurped, text "instance decls imported, out of",
 765                 int (n_insts_slurped + n_insts_left), text "read"],
 766          hsep [ int n_rules_slurped, text "rule decls imported, out of",
 767                 int (n_rules_slurped + n_rules_left), text "read"]
 768         ]
 769
 770 count_decls decls
 771   = (class_decls,
 772      data_decls,
 773      newtype_decls,
 774      syn_decls,
 775      val_decls,
 776      inst_decls)
 777   where
 778     tycl_decls = [d | TyClD d <- decls]
 779     (class_decls, data_decls, newtype_decls, syn_decls, val_decls) = countTyClDecls tycl_decls
 780
 781     inst_decls    = length [() | InstD _  <- decls]
 782 \end{code}
 783
 784
 785 %************************************************************************
 786 %*                                                                      *
 787 \subsection{Errors and warnings}
 788 %*                                                                      *
 789 %************************************************************************
 790
 791 \begin{code}
 792 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
 793 warnDeprec (name, txt)
 794   = pushSrcLocRn (getSrcLoc name)       $
 795     addWarnRn                           $
 796     sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
 797           text "is deprecated:", nest 4 (ppr txt) ]
 798
 799
 800 dupFixityDecl rdr_name loc1 loc2
 801   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 802           ptext SLIT("at ") <+> ppr loc1,
 803           ptext SLIT("and") <+> ppr loc2]
 804
 805 badDeprec d
 806   = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
 807          nest 4 (ppr d)]
 808
 809 noMainErr
 810   = hsep [ptext SLIT("Module"), quotes (ppr mAIN_Name),
 811           ptext SLIT("must include a definition for"), quotes (ptext SLIT("main"))]
 812 \end{code}
 813
 814