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 (
   8         renameModule, renameStmt, renameRdrName,
   9         closeIfaceDecls, checkOldIface
  10   ) where
  11
  12 #include "HsVersions.h"
  13
  14 import HsSyn
  15 import RdrHsSyn         ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation,
  16                           RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl,
  17                           RdrNameStmt
  18                         )
  19 import RnHsSyn          ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
  20                           RenamedStmt,
  21                           instDeclFVs, tyClDeclFVs, ruleDeclFVs
  22                         )
  23
  24 import CmdLineOpts      ( DynFlags, DynFlag(..) )
  25 import RnMonad
  26 import RnExpr           ( rnStmt )
  27 import RnNames          ( getGlobalNames, exportsFromAvail )
  28 import RnSource         ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
  29 import RnIfaces         ( slurpImpDecls, mkImportInfo, recordLocalSlurps,
  30                           closeDecls,
  31                           RecompileRequired, outOfDate, recompileRequired
  32                         )
  33 import RnHiFiles        ( readIface, loadInterface,
  34                           loadExports, loadFixDecls, loadDeprecs,
  35                         )
  36 import RnEnv            ( availsToNameSet, mkIfaceGlobalRdrEnv,
  37                           unitAvailEnv, availEnvElts,
  38                           plusAvailEnv, groupAvails, warnUnusedImports,
  39                           warnUnusedLocalBinds, warnUnusedModules,
  40                           lookupSrcName, getImplicitStmtFVs,
  41                           getImplicitModuleFVs, newGlobalName, unQualInScope,
  42                           ubiquitousNames, lookupOccRn
  43                         )
  44 import Module           ( Module, ModuleName, WhereFrom(..),
  45                           moduleNameUserString, moduleName,
  46                           moduleEnvElts
  47                         )
  48 import Name             ( Name, nameModule )
  49 import NameEnv
  50 import NameSet
  51 import RdrName          ( foldRdrEnv, isQual )
  52 import PrelNames        ( pRELUDE_Name )
  53 import ErrUtils         ( dumpIfSet, dumpIfSet_dyn, showPass,
  54                           printErrorsAndWarnings, errorsFound )
  55 import Bag              ( bagToList )
  56 import FiniteMap        ( FiniteMap, fmToList, emptyFM, lookupFM,
  57                           addToFM_C, elemFM, addToFM
  58                         )
  59 import Maybes           ( maybeToBool, catMaybes )
  60 import Outputable
  61 import IO               ( openFile, IOMode(..) )
  62 import HscTypes         -- lots of it
  63 import List             ( partition, nub )
  64 \end{code}
  65
  66
  67
  68
  69 %*********************************************************
  70 %*                                                       *
  71 \subsection{The main wrappers}
  72 %*                                                       *
  73 %*********************************************************
  74
  75 \begin{code}
  76 renameModule :: DynFlags
  77              -> HomeIfaceTable -> HomeSymbolTable
  78              -> PersistentCompilerState
  79              -> Module -> RdrNameHsModule
  80              -> IO (PersistentCompilerState, PrintUnqualified,
  81                     Maybe (IsExported, ModIface, [RenamedHsDecl]))
  82         -- Nothing => some error occurred in the renamer
  83
  84 renameModule dflags hit hst pcs this_module rdr_module
  85   = renameSource dflags hit hst pcs this_module $
  86     rename this_module rdr_module
  87 \end{code}
  88
  89 \begin{code}
  90 renameStmt :: DynFlags
  91            -> HomeIfaceTable -> HomeSymbolTable
  92            -> PersistentCompilerState
  93            -> Module                    -- current module
  94            -> InteractiveContext
  95            -> RdrNameStmt               -- parsed stmt
  96            -> IO ( PersistentCompilerState,
  97                    PrintUnqualified,
  98                    Maybe ([Name], (RenamedStmt, [RenamedHsDecl]))
  99                  )
 100
 101 renameStmt dflags hit hst pcs this_module ic stmt
 102   = renameSource dflags hit hst pcs this_module $
 103     extendTypeEnvRn (ic_type_env ic)            $
 104
 105         -- load the context module
 106     loadContextModule (ic_module ic) $ \ (rdr_env, print_unqual) ->
 107
 108         -- Rename the stmt
 109     initRnMS rdr_env emptyAvailEnv (ic_rn_env ic) emptyLocalFixityEnv CmdLineMode (
 110         rnStmt stmt     $ \ stmt' ->
 111         returnRn (([], stmt'), emptyFVs)
 112     )                                   `thenRn` \ ((binders, stmt), fvs) ->
 113
 114         -- Bale out if we fail
 115     checkErrsRn                         `thenRn` \ no_errs_so_far ->
 116     if not no_errs_so_far then
 117         doDump dflags [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
 118     else
 119
 120         -- Add implicit free vars, and close decls
 121     getImplicitStmtFVs                          `thenRn` \ implicit_fvs ->
 122     slurpImpDecls (fvs `plusFV` implicit_fvs)   `thenRn` \ decls ->
 123         -- NB: an earlier version deleted (rdrEnvElts local_env) from
 124         --     the fvs.  But (a) that isn't necessary, because previously
 125         --     bound things in the local_env will be in the TypeEnv, and
 126         --     the renamer doesn't re-slurp such things, and
 127         -- (b) it's WRONG to delete them. Consider in GHCi:
 128         --        Mod> let x = e :: T
 129         --        Mod> let y = x + 3
 130         --     We need to pass 'x' among the fvs to slurpImpDecls, so that
 131         --     the latter can see that T is a gate, and hence import the Num T
 132         --     instance decl.  (See the InTypEnv case in RnIfaces.slurpSourceRefs.)
 133
 134     doDump dflags binders stmt decls    `thenRn_`
 135     returnRn (print_unqual, Just (binders, (stmt, decls)))
 136
 137   where
 138      doDump :: DynFlags -> [Name] -> RenamedStmt -> [RenamedHsDecl]
 139          -> RnMG (Either IOError ())
 140      doDump dflags bndrs stmt decls
 141         = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
 142                         (vcat [text "Binders:" <+> ppr bndrs,
 143                                ppr stmt, text "",
 144                                vcat (map ppr decls)]))
 145
 146
 147 renameRdrName
 148            :: DynFlags
 149            -> HomeIfaceTable -> HomeSymbolTable
 150            -> PersistentCompilerState
 151            -> Module                    -- current module
 152            -> InteractiveContext
 153            -> [RdrName]                 -- name to rename
 154            -> IO ( PersistentCompilerState,
 155                    PrintUnqualified,
 156                    Maybe ([Name], [RenamedHsDecl])
 157                  )
 158
 159 renameRdrName dflags hit hst pcs this_module ic rdr_names =
 160   renameSource dflags hit hst pcs this_module   $
 161   extendTypeEnvRn (ic_type_env ic)              $
 162   loadContextModule (ic_module ic) $ \ (rdr_env, print_unqual) ->
 163
 164   -- rename the rdr_name
 165   initRnMS rdr_env emptyAvailEnv (ic_rn_env ic) emptyLocalFixityEnv CmdLineMode
 166         (mapRn (tryRn.lookupOccRn) rdr_names)   `thenRn` \ maybe_names ->
 167   let
 168         ok_names = [ a | Right a <- maybe_names ]
 169   in
 170   if null ok_names
 171         then let errs = head [ e | Left e <- maybe_names ]
 172              in setErrsRn errs            `thenRn_`
 173                 doDump dflags ok_names [] `thenRn_`
 174                 returnRn (print_unqual, Nothing)
 175         else
 176
 177   slurpImpDecls (mkNameSet ok_names)    `thenRn` \ decls ->
 178
 179   doDump dflags ok_names decls          `thenRn_`
 180   returnRn (print_unqual, Just (ok_names, decls))
 181  where
 182      doDump :: DynFlags -> [Name] -> [RenamedHsDecl] -> RnMG (Either IOError ())
 183      doDump dflags names decls
 184         = ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
 185                         (vcat [ppr names, text "",
 186                                vcat (map ppr decls)]))
 187
 188
 189 -- Load the interface for the context module, so
 190 -- that we can get its top-level lexical environment
 191 -- Bale out if we fail to do this
 192 loadContextModule scope_module thing_inside
 193   = let doc = text "context for compiling expression"
 194     in
 195     loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface ->
 196     let rdr_env       = mi_globals iface
 197         print_unqual  = unQualInScope rdr_env
 198     in
 199     checkErrsRn                         `thenRn` \ no_errs_so_far ->
 200     if not no_errs_so_far then
 201         returnRn (print_unqual, Nothing)
 202     else
 203         thing_inside (rdr_env, print_unqual)
 204 \end{code}
 205
 206 %*********************************************************
 207 %*                                                       *
 208 \subsection{The main function: rename}
 209 %*                                                       *
 210 %*********************************************************
 211
 212 \begin{code}
 213 renameSource :: DynFlags
 214              -> HomeIfaceTable -> HomeSymbolTable
 215              -> PersistentCompilerState
 216              -> Module
 217              -> RnMG (PrintUnqualified, Maybe r)
 218              -> IO (PersistentCompilerState, PrintUnqualified, Maybe r)
 219         -- Nothing => some error occurred in the renamer
 220
 221 renameSource dflags hit hst old_pcs this_module thing_inside
 222   = do  { showPass dflags "Renamer"
 223
 224                 -- Initialise the renamer monad
 225         ; (new_pcs, msgs, (print_unqual, maybe_rn_stuff))
 226                 <- initRn dflags hit hst old_pcs this_module thing_inside
 227
 228                 -- Print errors from renaming
 229         ;  printErrorsAndWarnings print_unqual msgs ;
 230
 231                 -- Return results.  No harm in updating the PCS
 232         ; if errorsFound msgs then
 233             return (new_pcs, print_unqual, Nothing)
 234           else
 235             return (new_pcs, print_unqual, maybe_rn_stuff)
 236     }
 237 \end{code}
 238
 239 \begin{code}
 240 rename :: Module -> RdrNameHsModule
 241        -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, [RenamedHsDecl]))
 242 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
 243   = pushSrcLocRn loc            $
 244
 245         -- FIND THE GLOBAL NAME ENVIRONMENT
 246     getGlobalNames this_module contents         `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
 247     let
 248         print_unqualified = unQualInScope gbl_env
 249     in
 250         -- Exit if we've found any errors
 251     checkErrsRn                         `thenRn` \ no_errs_so_far ->
 252     if not no_errs_so_far then
 253         -- Found errors already, so exit now
 254         rnDump [] []            `thenRn_`
 255         returnRn (print_unqualified, Nothing)
 256     else
 257
 258         -- PROCESS EXPORT LIST
 259     exportsFromAvail mod_name exports all_avails gbl_env        `thenRn` \ export_avails ->
 260
 261     traceRn (text "Local top-level environment" $$
 262              nest 4 (pprGlobalRdrEnv local_gbl_env))    `thenRn_`
 263
 264         -- DEAL WITH DEPRECATIONS
 265     rnDeprecs local_gbl_env mod_deprec
 266               [d | DeprecD d <- local_decls]            `thenRn` \ my_deprecs ->
 267
 268         -- DEAL WITH LOCAL FIXITIES
 269     fixitiesFromLocalDecls local_gbl_env local_decls    `thenRn` \ local_fixity_env ->
 270
 271         -- RENAME THE SOURCE
 272     rnSourceDecls gbl_env global_avail_env
 273                   local_fixity_env local_decls          `thenRn` \ (rn_local_decls, source_fvs) ->
 274
 275         -- EXIT IF ERRORS FOUND
 276         -- We exit here if there are any errors in the source, *before*
 277         -- we attempt to slurp the decls from the interfaces, otherwise
 278         -- the slurped decls may get lost when we return up the stack
 279         -- to hscMain/hscExpr.
 280     checkErrsRn                                 `thenRn` \ no_errs_so_far ->
 281     if not no_errs_so_far then
 282         -- Found errors already, so exit now
 283         rnDump [] rn_local_decls                `thenRn_`
 284         returnRn (print_unqualified, Nothing)
 285     else
 286
 287         -- SLURP IN ALL THE NEEDED DECLARATIONS
 288         -- Find out what re-bindable names to use for desugaring
 289     getImplicitModuleFVs mod_name rn_local_decls        `thenRn` \ implicit_fvs ->
 290     let
 291         export_fvs  = availsToNameSet export_avails
 292         source_fvs2 = source_fvs `plusFV` export_fvs
 293                 -- The export_fvs make the exported names look just as if they
 294                 -- occurred in the source program.  For the reasoning, see the
 295                 -- comments with RnIfaces.mkImportInfo
 296                 -- It also helps reportUnusedNames, which of course must not complain
 297                 -- that 'f' isn't mentioned if it is mentioned in the export list
 298
 299         source_fvs3 = implicit_fvs `plusFV` source_fvs2
 300                 -- It's important to do the "plus" this way round, so that
 301                 -- when compiling the prelude, locally-defined (), Bool, etc
 302                 -- override the implicit ones.
 303
 304     in
 305     traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList source_fvs3))) `thenRn_`
 306     slurpImpDecls source_fvs3                   `thenRn` \ rn_imp_decls ->
 307     rnDump rn_imp_decls rn_local_decls          `thenRn_`
 308
 309         -- GENERATE THE VERSION/USAGE INFO
 310     mkImportInfo mod_name imports               `thenRn` \ my_usages ->
 311
 312         -- BUILD THE MODULE INTERFACE
 313     let
 314         -- We record fixities even for things that aren't exported,
 315         -- so that we can change into the context of this moodule easily
 316         fixities = mkNameEnv [ (name, fixity)
 317                              | FixitySig name fixity loc <- nameEnvElts local_fixity_env
 318                              ]
 319
 320         -- Sort the exports to make them easier to compare for versions
 321         my_exports = groupAvails this_module export_avails
 322
 323         final_decls = rn_local_decls ++ rn_imp_decls
 324
 325         mod_iface = ModIface {  mi_module   = this_module,
 326                                 mi_version  = initialVersionInfo,
 327                                 mi_usages   = my_usages,
 328                                 mi_boot     = False,
 329                                 mi_orphan   = panic "is_orphan",
 330                                 mi_exports  = my_exports,
 331                                 mi_globals  = gbl_env,
 332                                 mi_fixities = fixities,
 333                                 mi_deprecs  = my_deprecs,
 334                                 mi_decls    = panic "mi_decls"
 335                     }
 336
 337         is_exported name  = name `elemNameSet` exported_names
 338         exported_names    = availsToNameSet export_avails
 339     in
 340
 341         -- REPORT UNUSED NAMES, AND DEBUG DUMP
 342     reportUnusedNames mod_iface print_unqualified
 343                       imports global_avail_env
 344                       source_fvs2 rn_imp_decls          `thenRn_`
 345                 -- NB: source_fvs2: include exports (else we get bogus
 346                 --     warnings of unused things) but not implicit FVs.
 347
 348     returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
 349   where
 350     mod_name = moduleName this_module
 351 \end{code}
 352
 353
 354
 355 %*********************************************************
 356 %*                                                       *
 357 \subsection{Fixities}
 358 %*                                                       *
 359 %*********************************************************
 360
 361 \begin{code}
 362 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
 363 fixitiesFromLocalDecls gbl_env decls
 364   = foldlRn getFixities emptyNameEnv decls                              `thenRn` \ env ->
 365     traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))    `thenRn_`
 366     returnRn env
 367   where
 368     getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
 369     getFixities acc (FixD fix)
 370       = fix_decl acc fix
 371
 372     getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
 373       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
 374                 -- Get fixities from class decl sigs too.
 375     getFixities acc other_decl
 376       = returnRn acc
 377
 378     fix_decl acc sig@(FixitySig rdr_name fixity loc)
 379         =       -- Check for fixity decl for something not declared
 380           pushSrcLocRn loc                      $
 381           lookupSrcName gbl_env rdr_name        `thenRn` \ name ->
 382
 383                 -- Check for duplicate fixity decl
 384           case lookupNameEnv acc name of
 385             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')     `thenRn_`
 386                                          returnRn acc ;
 387
 388             Nothing                   -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
 389 \end{code}
 390
 391
 392 %*********************************************************
 393 %*                                                       *
 394 \subsection{Deprecations}
 395 %*                                                       *
 396 %*********************************************************
 397
 398 For deprecations, all we do is check that the names are in scope.
 399 It's only imported deprecations, dealt with in RnIfaces, that we
 400 gather them together.
 401
 402 \begin{code}
 403 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
 404            -> [RdrNameDeprecation] -> RnMG Deprecations
 405 rnDeprecs gbl_env Nothing []
 406  = returnRn NoDeprecs
 407
 408 rnDeprecs gbl_env (Just txt) decls
 409  = mapRn (addErrRn . badDeprec) decls   `thenRn_`
 410    returnRn (DeprecAll txt)
 411
 412 rnDeprecs gbl_env Nothing decls
 413   = mapRn rn_deprec decls       `thenRn` \ pairs ->
 414     returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
 415  where
 416    rn_deprec (Deprecation rdr_name txt loc)
 417      = pushSrcLocRn loc                         $
 418        lookupSrcName gbl_env rdr_name           `thenRn` \ name ->
 419        returnRn (Just (name, (name,txt)))
 420 \end{code}
 421
 422
 423 %************************************************************************
 424 %*                                                                      *
 425 \subsection{Grabbing the old interface file and checking versions}
 426 %*                                                                      *
 427 %************************************************************************
 428
 429 \begin{code}
 430 checkOldIface :: GhciMode
 431               -> DynFlags
 432               -> HomeIfaceTable -> HomeSymbolTable
 433               -> PersistentCompilerState
 434               -> FilePath
 435               -> Bool                   -- Source unchanged
 436               -> Maybe ModIface         -- Old interface from compilation manager, if any
 437               -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
 438                                 -- True <=> errors happened
 439
 440 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
 441     = runRn dflags hit hst pcs (panic "Bogus module") $
 442
 443         -- CHECK WHETHER THE SOURCE HAS CHANGED
 444     ( if not source_unchanged then
 445         traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
 446       else returnRn () )   `thenRn_`
 447
 448      -- If the source has changed and we're in interactive mode, avoid reading
 449      -- an interface; just return the one we might have been supplied with.
 450     if ghci_mode == Interactive && not source_unchanged then
 451          returnRn (outOfDate, maybe_iface)
 452     else
 453
 454     case maybe_iface of
 455        Just old_iface -> -- Use the one we already have
 456                          setModuleRn (mi_module old_iface) (check_versions old_iface)
 457
 458        Nothing -- try and read it from a file
 459           -> readIface iface_path       `thenRn` \ read_result ->
 460              case read_result of
 461                Left err -> -- Old interface file not found, or garbled; give up
 462                            traceHiDiffsRn (
 463                                 text "Cannot read old interface file:"
 464                                    $$ nest 4 err) `thenRn_`
 465                            returnRn (outOfDate, Nothing)
 466
 467                Right parsed_iface
 468                       -> setModuleRn (pi_mod parsed_iface) $
 469                          loadOldIface parsed_iface `thenRn` \ m_iface ->
 470                          check_versions m_iface
 471     where
 472        check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
 473        check_versions iface
 474           | not source_unchanged
 475           = returnRn (outOfDate, Just iface)
 476           | otherwise
 477           = -- Check versions
 478             recompileRequired iface_path iface  `thenRn` \ recompile ->
 479             returnRn (recompile, Just iface)
 480 \end{code}
 481
 482 I think the following function should now have a more representative name,
 483 but what?
 484
 485 \begin{code}
 486 loadOldIface :: ParsedIface -> RnMG ModIface
 487
 488 loadOldIface parsed_iface
 489   = let iface = parsed_iface
 490         mod = pi_mod iface
 491     in
 492     initIfaceRnMS mod (
 493         loadHomeDecls (pi_decls iface)  `thenRn` \ decls ->
 494         loadHomeRules (pi_rules iface)  `thenRn` \ rules ->
 495         loadHomeInsts (pi_insts iface)  `thenRn` \ insts ->
 496         returnRn (decls, rules, insts)
 497     )
 498         `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
 499
 500     mapRn loadHomeUsage (pi_usages iface)       `thenRn` \ usages ->
 501     loadExports         (pi_exports iface)      `thenRn` \ (export_vers, avails) ->
 502     loadFixDecls mod    (pi_fixity iface)       `thenRn` \ fix_env ->
 503     loadDeprecs mod     (pi_deprecs iface)      `thenRn` \ deprec_env ->
 504     let
 505         version = VersionInfo { vers_module  = pi_vers iface,
 506                                 vers_exports = export_vers,
 507                                 vers_rules   = rule_vers,
 508                                 vers_decls   = decls_vers }
 509
 510         decls = mkIfaceDecls new_decls new_rules new_insts
 511
 512         mod_iface = ModIface { mi_module = mod, mi_version = version,
 513                                mi_exports = avails, mi_usages  = usages,
 514                                mi_boot = False, mi_orphan = pi_orphan iface,
 515                                mi_fixities = fix_env, mi_deprecs = deprec_env,
 516                                mi_decls   = decls,
 517                                mi_globals = mkIfaceGlobalRdrEnv avails
 518                     }
 519     in
 520     returnRn mod_iface
 521 \end{code}
 522
 523 \begin{code}
 524 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
 525               -> RnMS (NameEnv Version, [RenamedTyClDecl])
 526 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
 527
 528 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
 529              -> (Version, RdrNameTyClDecl)
 530              -> RnMS (NameEnv Version, [RenamedTyClDecl])
 531 loadHomeDecl (version_map, decls) (version, decl)
 532   = rnTyClDecl decl     `thenRn` \ decl' ->
 533     returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
 534
 535 ------------------
 536 loadHomeRules :: (Version, [RdrNameRuleDecl])
 537               -> RnMS (Version, [RenamedRuleDecl])
 538 loadHomeRules (version, rules)
 539   = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
 540     returnRn (version, rules')
 541
 542 ------------------
 543 loadHomeInsts :: [RdrNameInstDecl]
 544               -> RnMS [RenamedInstDecl]
 545 loadHomeInsts insts = mapRn rnInstDecl insts
 546
 547 ------------------
 548 loadHomeUsage :: ImportVersion OccName
 549               -> RnMG (ImportVersion Name)
 550 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
 551   = rn_imps whats_imported      `thenRn` \ whats_imported' ->
 552     returnRn (mod_name, orphans, is_boot, whats_imported')
 553   where
 554     rn_imps NothingAtAll                  = returnRn NothingAtAll
 555     rn_imps (Everything v)                = returnRn (Everything v)
 556     rn_imps (Specifically mv ev items rv) = mapRn rn_imp items  `thenRn` \ items' ->
 557                                             returnRn (Specifically mv ev items' rv)
 558     rn_imp (occ,vers) = newGlobalName mod_name occ      `thenRn` \ name ->
 559                         returnRn (name,vers)
 560 \end{code}
 561
 562
 563
 564 %*********************************************************
 565 %*                                                       *
 566 \subsection{Closing up the interface decls}
 567 %*                                                       *
 568 %*********************************************************
 569
 570 Suppose we discover we don't need to recompile.   Then we start from the
 571 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
 572
 573 \begin{code}
 574 closeIfaceDecls :: DynFlags
 575                 -> HomeIfaceTable -> HomeSymbolTable
 576                 -> PersistentCompilerState
 577                 -> ModIface     -- Get the decls from here
 578                 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
 579                                 -- True <=> errors happened
 580 closeIfaceDecls dflags hit hst pcs
 581                 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
 582   = runRn dflags hit hst pcs mod $
 583
 584     let
 585         rule_decls = dcl_rules iface_decls
 586         inst_decls = dcl_insts iface_decls
 587         tycl_decls = dcl_tycl  iface_decls
 588         decls = map RuleD rule_decls ++
 589                 map InstD inst_decls ++
 590                 map TyClD tycl_decls
 591         needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
 592                  unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
 593                  unionManyNameSets (map tyClDeclFVs tycl_decls)
 594         local_names    = foldl add emptyNameSet tycl_decls
 595         add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
 596     in
 597
 598     recordLocalSlurps local_names       `thenRn_`
 599
 600         -- Do the transitive closure
 601     closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
 602     rnDump [] closed_decls `thenRn_`
 603     returnRn closed_decls
 604   where
 605     implicit_fvs = ubiquitousNames      -- Data type decls with record selectors,
 606                                         -- which may appear in the decls, need unpackCString
 607                                         -- and friends. It's easier to just grab them right now.
 608 \end{code}
 609
 610 %*********************************************************
 611 %*                                                       *
 612 \subsection{Unused names}
 613 %*                                                       *
 614 %*********************************************************
 615
 616 \begin{code}
 617 reportUnusedNames :: ModIface -> PrintUnqualified
 618                   -> [RdrNameImportDecl]
 619                   -> AvailEnv
 620                   -> NameSet            -- Used in this module
 621                   -> [RenamedHsDecl]
 622                   -> RnMG ()
 623 reportUnusedNames my_mod_iface unqual imports avail_env
 624                   used_names imported_decls
 625   = warnUnusedModules unused_imp_mods                           `thenRn_`
 626     warnUnusedLocalBinds bad_locals                             `thenRn_`
 627     warnUnusedImports bad_imp_names                             `thenRn_`
 628     printMinimalImports this_mod unqual minimal_imports
 629   where
 630     this_mod   = mi_module my_mod_iface
 631     gbl_env    = mi_globals my_mod_iface
 632
 633     -- Now, a use of C implies a use of T,
 634     -- if C was brought into scope by T(..) or T(C)
 635     really_used_names = used_names `unionNameSets`
 636       mkNameSet [ parent_name
 637                 | sub_name <- nameSetToList used_names
 638
 639                 -- Usually, every used name will appear in avail_env, but there
 640                 -- is one time when it doesn't: tuples and other built in syntax.  When you
 641                 -- write (a,b) that gives rise to a *use* of "(,)", so that the
 642                 -- instances will get pulled in, but the tycon "(,)" isn't actually
 643                 -- in scope.  Also, (-x) gives rise to an implicit use of 'negate';
 644                 -- similarly,   3.5 gives rise to an implcit use of :%
 645                 -- Hence the silent 'False' in all other cases
 646
 647                 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
 648                                         Just (AvailTC n _) -> Just n
 649                                         other              -> Nothing]
 650             ]
 651
 652         -- Collect the defined names from the in-scope environment
 653         -- Look for the qualified ones only, else get duplicates
 654     defined_names :: [GlobalRdrElt]
 655     defined_names = foldRdrEnv add [] gbl_env
 656     add rdr_name ns acc | isQual rdr_name = ns ++ acc
 657                         | otherwise       = acc
 658
 659     defined_and_used, defined_but_not_used :: [GlobalRdrElt]
 660     (defined_and_used, defined_but_not_used) = partition used defined_names
 661     used (GRE name _ _)                      = name `elemNameSet` really_used_names
 662
 663     -- Filter out the ones only defined implicitly
 664     bad_locals :: [Name]
 665     bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
 666
 667     bad_imp_names :: [(Name,Provenance)]
 668     bad_imp_names  = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
 669                               not (module_unused mod)]
 670
 671     -- inst_mods are directly-imported modules that
 672     --  contain instance decl(s) that the renamer decided to suck in
 673     -- It's not necessarily redundant to import such modules.
 674     --
 675     -- NOTE: Consider
 676     --        module This
 677     --          import M ()
 678     --
 679     --   The import M() is not *necessarily* redundant, even if
 680     --   we suck in no instance decls from M (e.g. it contains
 681     --   no instance decls, or This contains no code).  It may be
 682     --   that we import M solely to ensure that M's orphan instance
 683     --   decls (or those in its imports) are visible to people who
 684     --   import This.  Sigh.
 685     --   There's really no good way to detect this, so the error message
 686     --   in RnEnv.warnUnusedModules is weakened instead
 687     inst_mods :: [ModuleName]
 688     inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
 689                  let m = moduleName (nameModule dfun),
 690                  m `elem` direct_import_mods
 691             ]
 692
 693     -- To figure out the minimal set of imports, start with the things
 694     -- that are in scope (i.e. in gbl_env).  Then just combine them
 695     -- into a bunch of avails, so they are properly grouped
 696     minimal_imports :: FiniteMap ModuleName AvailEnv
 697     minimal_imports0 = emptyFM
 698     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
 699     minimal_imports  = foldr add_inst_mod minimal_imports1 inst_mods
 700
 701         -- We've carefully preserved the provenance so that we can
 702         -- construct minimal imports that import the name by (one of)
 703         -- the same route(s) as the programmer originally did.
 704     add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
 705                                                                         (unitAvailEnv (mk_avail n))
 706     add_name (GRE n other_prov _)                       acc = acc
 707
 708     mk_avail n = case lookupNameEnv avail_env n of
 709                 Just (AvailTC m _) | n==m      -> AvailTC n [n]
 710                                    | otherwise -> AvailTC m [n,m]
 711                 Just avail         -> Avail n
 712                 Nothing            -> pprPanic "mk_avail" (ppr n)
 713
 714     add_inst_mod m acc
 715       | m `elemFM` acc = acc    -- We import something already
 716       | otherwise      = addToFM acc m emptyAvailEnv
 717         -- Add an empty collection of imports for a module
 718         -- from which we have sucked only instance decls
 719
 720     direct_import_mods :: [ModuleName]
 721     direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
 722
 723     -- unused_imp_mods are the directly-imported modules
 724     -- that are not mentioned in minimal_imports
 725     unused_imp_mods = [m | m <- direct_import_mods,
 726                        not (maybeToBool (lookupFM minimal_imports m)),
 727                        m /= pRELUDE_Name]
 728
 729     module_unused :: Module -> Bool
 730     module_unused mod = moduleName mod `elem` unused_imp_mods
 731
 732
 733 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
 734 printMinimalImports :: Module   -- This module
 735                     -> PrintUnqualified
 736                     -> FiniteMap ModuleName AvailEnv    -- Minimal imports
 737                     -> RnMG ()
 738 printMinimalImports this_mod unqual imps
 739   = ifOptRn Opt_D_dump_minimal_imports          $
 740
 741     mapRn to_ies (fmToList imps)                `thenRn` \ mod_ies ->
 742     ioToRnM (do { h <- openFile filename WriteMode ;
 743                   printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
 744         })                                      `thenRn_`
 745     returnRn ()
 746   where
 747     filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
 748     ppr_mod_ie (mod_name, ies)
 749         | mod_name == pRELUDE_Name
 750         = empty
 751         | otherwise
 752         = ptext SLIT("import") <+> ppr mod_name <>
 753                             parens (fsep (punctuate comma (map ppr ies)))
 754
 755     to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)      `thenRn` \ ies ->
 756                               returnRn (mod, ies)
 757
 758     to_ie :: AvailInfo -> RnMG (IE Name)
 759         -- The main trick here is that if we're importing all the constructors
 760         -- we want to say "T(..)", but if we're importing only a subset we want
 761         -- to say "T(A,B,C)".  So we have to find out what the module exports.
 762     to_ie (Avail n)       = returnRn (IEVar n)
 763     to_ie (AvailTC n [m]) = ASSERT( n==m )
 764                             returnRn (IEThingAbs n)
 765     to_ie (AvailTC n ns)
 766         = loadInterface (text "Compute minimal imports from" <+> ppr n_mod) n_mod ImportBySystem        `thenRn` \ iface ->
 767           case [xs | (m,as) <- mi_exports iface,
 768                      m == n_mod,
 769                      AvailTC x xs <- as,
 770                      x == n] of
 771               [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
 772                    | otherwise          -> returnRn (IEThingWith n (filter (/= n) ns))
 773               other                     -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
 774                                            returnRn (IEVar n)
 775         where
 776           n_mod = moduleName (nameModule n)
 777
 778 rnDump  :: [RenamedHsDecl]      -- Renamed imported decls
 779         -> [RenamedHsDecl]      -- Renamed local decls
 780         -> RnMG ()
 781 rnDump imp_decls local_decls
 782   = doptRn Opt_D_dump_rn_trace  `thenRn` \ dump_rn_trace ->
 783     doptRn Opt_D_dump_rn_stats  `thenRn` \ dump_rn_stats ->
 784     doptRn Opt_D_dump_rn        `thenRn` \ dump_rn ->
 785     getIfacesRn                 `thenRn` \ ifaces ->
 786
 787     ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
 788                             "Renamer statistics"
 789                             (getRnStats imp_decls ifaces) ;
 790
 791                   dumpIfSet dump_rn "Renamer:"
 792                             (vcat (map ppr (local_decls ++ imp_decls)))
 793     })                          `thenRn_`
 794
 795     returnRn ()
 796 \end{code}
 797
 798
 799 %*********************************************************
 800 %*                                                      *
 801 \subsection{Statistics}
 802 %*                                                      *
 803 %*********************************************************
 804
 805 \begin{code}
 806 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
 807 getRnStats imported_decls ifaces
 808   = hcat [text "Renamer stats: ", stats]
 809   where
 810     n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
 811         -- This is really only right for a one-shot compile
 812
 813     (decls_map, n_decls_slurped) = iDecls ifaces
 814
 815     n_decls_left   = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
 816                         -- Data, newtype, and class decls are in the decls_fm
 817                         -- under multiple names; the tycon/class, and each
 818                         -- constructor/class op too.
 819                         -- The 'True' selects just the 'main' decl
 820                      ]
 821
 822     (insts_left, n_insts_slurped) = iInsts ifaces
 823     n_insts_left  = length (bagToList insts_left)
 824
 825     (rules_left, n_rules_slurped) = iRules ifaces
 826     n_rules_left  = length (bagToList rules_left)
 827
 828     stats = vcat
 829         [int n_mods <+> text "interfaces read",
 830          hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
 831                 int (n_decls_slurped + n_decls_left), text "read"],
 832          hsep [ int n_insts_slurped, text "instance decls imported, out of",
 833                 int (n_insts_slurped + n_insts_left), text "read"],
 834          hsep [ int n_rules_slurped, text "rule decls imported, out of",
 835                 int (n_rules_slurped + n_rules_left), text "read"]
 836         ]
 837 \end{code}
 838
 839
 840 %************************************************************************
 841 %*                                                                      *
 842 \subsection{Errors and warnings}
 843 %*                                                                      *
 844 %************************************************************************
 845
 846 \begin{code}
 847 dupFixityDecl rdr_name loc1 loc2
 848   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 849           ptext SLIT("at ") <+> ppr loc1,
 850           ptext SLIT("and") <+> ppr loc2]
 851
 852 badDeprec d
 853   = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
 854          nest 4 (ppr d)]
 855 \end{code}
 856
 857