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