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                           emptyAvailEnv, 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 (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 (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 local_fixity_env local_decls  `thenRn` \ (rn_local_decls, source_fvs) ->
 273
 274         -- EXIT IF ERRORS FOUND
 275         -- We exit here if there are any errors in the source, *before*
 276         -- we attempt to slurp the decls from the interfaces, otherwise
 277         -- the slurped decls may get lost when we return up the stack
 278         -- to hscMain/hscExpr.
 279     checkErrsRn                                 `thenRn` \ no_errs_so_far ->
 280     if not no_errs_so_far then
 281         -- Found errors already, so exit now
 282         rnDump [] rn_local_decls                `thenRn_`
 283         returnRn (print_unqualified, Nothing)
 284     else
 285
 286         -- SLURP IN ALL THE NEEDED DECLARATIONS
 287         -- Find out what re-bindable names to use for desugaring
 288     getImplicitModuleFVs mod_name rn_local_decls        `thenRn` \ implicit_fvs ->
 289     let
 290         export_fvs  = availsToNameSet export_avails
 291         source_fvs2 = source_fvs `plusFV` export_fvs
 292                 -- The export_fvs make the exported names look just as if they
 293                 -- occurred in the source program.  For the reasoning, see the
 294                 -- comments with RnIfaces.mkImportInfo
 295                 -- It also helps reportUnusedNames, which of course must not complain
 296                 -- that 'f' isn't mentioned if it is mentioned in the export list
 297
 298         source_fvs3 = implicit_fvs `plusFV` source_fvs2
 299                 -- It's important to do the "plus" this way round, so that
 300                 -- when compiling the prelude, locally-defined (), Bool, etc
 301                 -- override the implicit ones.
 302
 303     in
 304     traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList source_fvs3))) `thenRn_`
 305     slurpImpDecls source_fvs3                   `thenRn` \ rn_imp_decls ->
 306     rnDump rn_imp_decls rn_local_decls          `thenRn_`
 307
 308         -- GENERATE THE VERSION/USAGE INFO
 309     mkImportInfo mod_name imports               `thenRn` \ my_usages ->
 310
 311         -- BUILD THE MODULE INTERFACE
 312     let
 313         -- We record fixities even for things that aren't exported,
 314         -- so that we can change into the context of this moodule easily
 315         fixities = mkNameEnv [ (name, fixity)
 316                              | FixitySig name fixity loc <- nameEnvElts local_fixity_env
 317                              ]
 318
 319         -- Sort the exports to make them easier to compare for versions
 320         my_exports = groupAvails this_module export_avails
 321
 322         final_decls = rn_local_decls ++ rn_imp_decls
 323
 324         mod_iface = ModIface {  mi_module   = this_module,
 325                                 mi_version  = initialVersionInfo,
 326                                 mi_usages   = my_usages,
 327                                 mi_boot     = False,
 328                                 mi_orphan   = panic "is_orphan",
 329                                 mi_exports  = my_exports,
 330                                 mi_globals  = gbl_env,
 331                                 mi_fixities = fixities,
 332                                 mi_deprecs  = my_deprecs,
 333                                 mi_decls    = panic "mi_decls"
 334                     }
 335
 336         is_exported name  = name `elemNameSet` exported_names
 337         exported_names    = availsToNameSet export_avails
 338     in
 339
 340         -- REPORT UNUSED NAMES, AND DEBUG DUMP
 341     reportUnusedNames mod_iface print_unqualified
 342                       imports global_avail_env
 343                       source_fvs2 rn_imp_decls          `thenRn_`
 344                 -- NB: source_fvs2: include exports (else we get bogus
 345                 --     warnings of unused things) but not implicit FVs.
 346
 347     returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
 348   where
 349     mod_name = moduleName this_module
 350 \end{code}
 351
 352
 353
 354 %*********************************************************
 355 %*                                                       *
 356 \subsection{Fixities}
 357 %*                                                       *
 358 %*********************************************************
 359
 360 \begin{code}
 361 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
 362 fixitiesFromLocalDecls gbl_env decls
 363   = foldlRn getFixities emptyNameEnv decls                              `thenRn` \ env ->
 364     traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))    `thenRn_`
 365     returnRn env
 366   where
 367     getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
 368     getFixities acc (FixD fix)
 369       = fix_decl acc fix
 370
 371     getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
 372       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
 373                 -- Get fixities from class decl sigs too.
 374     getFixities acc other_decl
 375       = returnRn acc
 376
 377     fix_decl acc sig@(FixitySig rdr_name fixity loc)
 378         =       -- Check for fixity decl for something not declared
 379           pushSrcLocRn loc                      $
 380           lookupSrcName gbl_env rdr_name        `thenRn` \ name ->
 381
 382                 -- Check for duplicate fixity decl
 383           case lookupNameEnv acc name of
 384             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')     `thenRn_`
 385                                          returnRn acc ;
 386
 387             Nothing                   -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
 388 \end{code}
 389
 390
 391 %*********************************************************
 392 %*                                                       *
 393 \subsection{Deprecations}
 394 %*                                                       *
 395 %*********************************************************
 396
 397 For deprecations, all we do is check that the names are in scope.
 398 It's only imported deprecations, dealt with in RnIfaces, that we
 399 gather them together.
 400
 401 \begin{code}
 402 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
 403            -> [RdrNameDeprecation] -> RnMG Deprecations
 404 rnDeprecs gbl_env Nothing []
 405  = returnRn NoDeprecs
 406
 407 rnDeprecs gbl_env (Just txt) decls
 408  = mapRn (addErrRn . badDeprec) decls   `thenRn_`
 409    returnRn (DeprecAll txt)
 410
 411 rnDeprecs gbl_env Nothing decls
 412   = mapRn rn_deprec decls       `thenRn` \ pairs ->
 413     returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
 414  where
 415    rn_deprec (Deprecation rdr_name txt loc)
 416      = pushSrcLocRn loc                         $
 417        lookupSrcName gbl_env rdr_name           `thenRn` \ name ->
 418        returnRn (Just (name, (name,txt)))
 419 \end{code}
 420
 421
 422 %************************************************************************
 423 %*                                                                      *
 424 \subsection{Grabbing the old interface file and checking versions}
 425 %*                                                                      *
 426 %************************************************************************
 427
 428 \begin{code}
 429 checkOldIface :: GhciMode
 430               -> DynFlags
 431               -> HomeIfaceTable -> HomeSymbolTable
 432               -> PersistentCompilerState
 433               -> FilePath
 434               -> Bool                   -- Source unchanged
 435               -> Maybe ModIface         -- Old interface from compilation manager, if any
 436               -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
 437                                 -- True <=> errors happened
 438
 439 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
 440     = runRn dflags hit hst pcs (panic "Bogus module") $
 441
 442         -- CHECK WHETHER THE SOURCE HAS CHANGED
 443     ( if not source_unchanged then
 444         traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
 445       else returnRn () )   `thenRn_`
 446
 447      -- If the source has changed and we're in interactive mode, avoid reading
 448      -- an interface; just return the one we might have been supplied with.
 449     if ghci_mode == Interactive && not source_unchanged then
 450          returnRn (outOfDate, maybe_iface)
 451     else
 452
 453     case maybe_iface of
 454        Just old_iface -> -- Use the one we already have
 455                          setModuleRn (mi_module old_iface) (check_versions old_iface)
 456
 457        Nothing -- try and read it from a file
 458           -> readIface iface_path       `thenRn` \ read_result ->
 459              case read_result of
 460                Left err -> -- Old interface file not found, or garbled; give up
 461                            traceHiDiffsRn (
 462                                 text "Cannot read old interface file:"
 463                                    $$ nest 4 err) `thenRn_`
 464                            returnRn (outOfDate, Nothing)
 465
 466                Right parsed_iface
 467                       -> setModuleRn (pi_mod parsed_iface) $
 468                          loadOldIface parsed_iface `thenRn` \ m_iface ->
 469                          check_versions m_iface
 470     where
 471        check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
 472        check_versions iface
 473           | not source_unchanged
 474           = returnRn (outOfDate, Just iface)
 475           | otherwise
 476           = -- Check versions
 477             recompileRequired iface_path iface  `thenRn` \ recompile ->
 478             returnRn (recompile, Just iface)
 479 \end{code}
 480
 481 I think the following function should now have a more representative name,
 482 but what?
 483
 484 \begin{code}
 485 loadOldIface :: ParsedIface -> RnMG ModIface
 486
 487 loadOldIface parsed_iface
 488   = let iface = parsed_iface
 489         mod = pi_mod iface
 490     in
 491     initIfaceRnMS mod (
 492         loadHomeDecls (pi_decls iface)  `thenRn` \ decls ->
 493         loadHomeRules (pi_rules iface)  `thenRn` \ rules ->
 494         loadHomeInsts (pi_insts iface)  `thenRn` \ insts ->
 495         returnRn (decls, rules, insts)
 496     )
 497         `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
 498
 499     mapRn loadHomeUsage (pi_usages iface)       `thenRn` \ usages ->
 500     loadExports         (pi_exports iface)      `thenRn` \ (export_vers, avails) ->
 501     loadFixDecls mod    (pi_fixity iface)       `thenRn` \ fix_env ->
 502     loadDeprecs mod     (pi_deprecs iface)      `thenRn` \ deprec_env ->
 503     let
 504         version = VersionInfo { vers_module  = pi_vers iface,
 505                                 vers_exports = export_vers,
 506                                 vers_rules   = rule_vers,
 507                                 vers_decls   = decls_vers }
 508
 509         decls = mkIfaceDecls new_decls new_rules new_insts
 510
 511         mod_iface = ModIface { mi_module = mod, mi_version = version,
 512                                mi_exports = avails, mi_usages  = usages,
 513                                mi_boot = False, mi_orphan = pi_orphan iface,
 514                                mi_fixities = fix_env, mi_deprecs = deprec_env,
 515                                mi_decls   = decls,
 516                                mi_globals = mkIfaceGlobalRdrEnv avails
 517                     }
 518     in
 519     returnRn mod_iface
 520 \end{code}
 521
 522 \begin{code}
 523 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
 524               -> RnMS (NameEnv Version, [RenamedTyClDecl])
 525 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
 526
 527 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
 528              -> (Version, RdrNameTyClDecl)
 529              -> RnMS (NameEnv Version, [RenamedTyClDecl])
 530 loadHomeDecl (version_map, decls) (version, decl)
 531   = rnTyClDecl decl     `thenRn` \ decl' ->
 532     returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
 533
 534 ------------------
 535 loadHomeRules :: (Version, [RdrNameRuleDecl])
 536               -> RnMS (Version, [RenamedRuleDecl])
 537 loadHomeRules (version, rules)
 538   = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
 539     returnRn (version, rules')
 540
 541 ------------------
 542 loadHomeInsts :: [RdrNameInstDecl]
 543               -> RnMS [RenamedInstDecl]
 544 loadHomeInsts insts = mapRn rnInstDecl insts
 545
 546 ------------------
 547 loadHomeUsage :: ImportVersion OccName
 548               -> RnMG (ImportVersion Name)
 549 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
 550   = rn_imps whats_imported      `thenRn` \ whats_imported' ->
 551     returnRn (mod_name, orphans, is_boot, whats_imported')
 552   where
 553     rn_imps NothingAtAll                  = returnRn NothingAtAll
 554     rn_imps (Everything v)                = returnRn (Everything v)
 555     rn_imps (Specifically mv ev items rv) = mapRn rn_imp items  `thenRn` \ items' ->
 556                                             returnRn (Specifically mv ev items' rv)
 557     rn_imp (occ,vers) = newGlobalName mod_name occ      `thenRn` \ name ->
 558                         returnRn (name,vers)
 559 \end{code}
 560
 561
 562
 563 %*********************************************************
 564 %*                                                       *
 565 \subsection{Closing up the interface decls}
 566 %*                                                       *
 567 %*********************************************************
 568
 569 Suppose we discover we don't need to recompile.   Then we start from the
 570 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
 571
 572 \begin{code}
 573 closeIfaceDecls :: DynFlags
 574                 -> HomeIfaceTable -> HomeSymbolTable
 575                 -> PersistentCompilerState
 576                 -> ModIface     -- Get the decls from here
 577                 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
 578                                 -- True <=> errors happened
 579 closeIfaceDecls dflags hit hst pcs
 580                 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
 581   = runRn dflags hit hst pcs mod $
 582
 583     let
 584         rule_decls = dcl_rules iface_decls
 585         inst_decls = dcl_insts iface_decls
 586         tycl_decls = dcl_tycl  iface_decls
 587         decls = map RuleD rule_decls ++
 588                 map InstD inst_decls ++
 589                 map TyClD tycl_decls
 590         needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
 591                  unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
 592                  unionManyNameSets (map tyClDeclFVs tycl_decls)
 593         local_names    = foldl add emptyNameSet tycl_decls
 594         add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
 595     in
 596
 597     recordLocalSlurps local_names       `thenRn_`
 598
 599         -- Do the transitive closure
 600     closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
 601     rnDump [] closed_decls `thenRn_`
 602     returnRn closed_decls
 603   where
 604     implicit_fvs = ubiquitousNames      -- Data type decls with record selectors,
 605                                         -- which may appear in the decls, need unpackCString
 606                                         -- and friends. It's easier to just grab them right now.
 607 \end{code}
 608
 609 %*********************************************************
 610 %*                                                       *
 611 \subsection{Unused names}
 612 %*                                                       *
 613 %*********************************************************
 614
 615 \begin{code}
 616 reportUnusedNames :: ModIface -> PrintUnqualified
 617                   -> [RdrNameImportDecl]
 618                   -> AvailEnv
 619                   -> NameSet            -- Used in this module
 620                   -> [RenamedHsDecl]
 621                   -> RnMG ()
 622 reportUnusedNames my_mod_iface unqual imports avail_env
 623                   used_names imported_decls
 624   = warnUnusedModules unused_imp_mods                           `thenRn_`
 625     warnUnusedLocalBinds bad_locals                             `thenRn_`
 626     warnUnusedImports bad_imp_names                             `thenRn_`
 627     printMinimalImports this_mod unqual minimal_imports
 628   where
 629     this_mod   = mi_module my_mod_iface
 630     gbl_env    = mi_globals my_mod_iface
 631
 632     -- Now, a use of C implies a use of T,
 633     -- if C was brought into scope by T(..) or T(C)
 634     really_used_names = used_names `unionNameSets`
 635       mkNameSet [ parent_name
 636                 | sub_name <- nameSetToList used_names
 637
 638                 -- Usually, every used name will appear in avail_env, but there
 639                 -- is one time when it doesn't: tuples and other built in syntax.  When you
 640                 -- write (a,b) that gives rise to a *use* of "(,)", so that the
 641                 -- instances will get pulled in, but the tycon "(,)" isn't actually
 642                 -- in scope.  Also, (-x) gives rise to an implicit use of 'negate';
 643                 -- similarly,   3.5 gives rise to an implcit use of :%
 644                 -- Hence the silent 'False' in all other cases
 645
 646                 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
 647                                         Just (AvailTC n _) -> Just n
 648                                         other              -> Nothing]
 649             ]
 650
 651         -- Collect the defined names from the in-scope environment
 652         -- Look for the qualified ones only, else get duplicates
 653     defined_names :: [GlobalRdrElt]
 654     defined_names = foldRdrEnv add [] gbl_env
 655     add rdr_name ns acc | isQual rdr_name = ns ++ acc
 656                         | otherwise       = acc
 657
 658     defined_and_used, defined_but_not_used :: [GlobalRdrElt]
 659     (defined_and_used, defined_but_not_used) = partition used defined_names
 660     used (GRE name _ _)                      = name `elemNameSet` really_used_names
 661
 662     -- Filter out the ones only defined implicitly
 663     bad_locals :: [Name]
 664     bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
 665
 666     bad_imp_names :: [(Name,Provenance)]
 667     bad_imp_names  = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
 668                               not (module_unused mod)]
 669
 670     -- inst_mods are directly-imported modules that
 671     --  contain instance decl(s) that the renamer decided to suck in
 672     -- It's not necessarily redundant to import such modules.
 673     --
 674     -- NOTE: Consider
 675     --        module This
 676     --          import M ()
 677     --
 678     --   The import M() is not *necessarily* redundant, even if
 679     --   we suck in no instance decls from M (e.g. it contains
 680     --   no instance decls, or This contains no code).  It may be
 681     --   that we import M solely to ensure that M's orphan instance
 682     --   decls (or those in its imports) are visible to people who
 683     --   import This.  Sigh.
 684     --   There's really no good way to detect this, so the error message
 685     --   in RnEnv.warnUnusedModules is weakened instead
 686     inst_mods :: [ModuleName]
 687     inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
 688                  let m = moduleName (nameModule dfun),
 689                  m `elem` direct_import_mods
 690             ]
 691
 692     -- To figure out the minimal set of imports, start with the things
 693     -- that are in scope (i.e. in gbl_env).  Then just combine them
 694     -- into a bunch of avails, so they are properly grouped
 695     minimal_imports :: FiniteMap ModuleName AvailEnv
 696     minimal_imports0 = emptyFM
 697     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
 698     minimal_imports  = foldr add_inst_mod minimal_imports1 inst_mods
 699
 700         -- We've carefully preserved the provenance so that we can
 701         -- construct minimal imports that import the name by (one of)
 702         -- the same route(s) as the programmer originally did.
 703     add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
 704                                                                         (unitAvailEnv (mk_avail n))
 705     add_name (GRE n other_prov _)                       acc = acc
 706
 707     mk_avail n = case lookupNameEnv avail_env n of
 708                 Just (AvailTC m _) | n==m      -> AvailTC n [n]
 709                                    | otherwise -> AvailTC m [n,m]
 710                 Just avail         -> Avail n
 711                 Nothing            -> pprPanic "mk_avail" (ppr n)
 712
 713     add_inst_mod m acc
 714       | m `elemFM` acc = acc    -- We import something already
 715       | otherwise      = addToFM acc m emptyAvailEnv
 716         -- Add an empty collection of imports for a module
 717         -- from which we have sucked only instance decls
 718
 719     direct_import_mods :: [ModuleName]
 720     direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
 721
 722     -- unused_imp_mods are the directly-imported modules
 723     -- that are not mentioned in minimal_imports
 724     unused_imp_mods = [m | m <- direct_import_mods,
 725                        not (maybeToBool (lookupFM minimal_imports m)),
 726                        m /= pRELUDE_Name]
 727
 728     module_unused :: Module -> Bool
 729     module_unused mod = moduleName mod `elem` unused_imp_mods
 730
 731
 732 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
 733 printMinimalImports :: Module   -- This module
 734                     -> PrintUnqualified
 735                     -> FiniteMap ModuleName AvailEnv    -- Minimal imports
 736                     -> RnMG ()
 737 printMinimalImports this_mod unqual imps
 738   = ifOptRn Opt_D_dump_minimal_imports          $
 739
 740     mapRn to_ies (fmToList imps)                `thenRn` \ mod_ies ->
 741     ioToRnM (do { h <- openFile filename WriteMode ;
 742                   printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
 743         })                                      `thenRn_`
 744     returnRn ()
 745   where
 746     filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
 747     ppr_mod_ie (mod_name, ies)
 748         | mod_name == pRELUDE_Name
 749         = empty
 750         | otherwise
 751         = ptext SLIT("import") <+> ppr mod_name <>
 752                             parens (fsep (punctuate comma (map ppr ies)))
 753
 754     to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)      `thenRn` \ ies ->
 755                               returnRn (mod, ies)
 756
 757     to_ie :: AvailInfo -> RnMG (IE Name)
 758         -- The main trick here is that if we're importing all the constructors
 759         -- we want to say "T(..)", but if we're importing only a subset we want
 760         -- to say "T(A,B,C)".  So we have to find out what the module exports.
 761     to_ie (Avail n)       = returnRn (IEVar n)
 762     to_ie (AvailTC n [m]) = ASSERT( n==m )
 763                             returnRn (IEThingAbs n)
 764     to_ie (AvailTC n ns)
 765         = loadInterface (text "Compute minimal imports from" <+> ppr n_mod) n_mod ImportBySystem        `thenRn` \ iface ->
 766           case [xs | (m,as) <- mi_exports iface,
 767                      m == n_mod,
 768                      AvailTC x xs <- as,
 769                      x == n] of
 770               [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
 771                    | otherwise          -> returnRn (IEThingWith n (filter (/= n) ns))
 772               other                     -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
 773                                            returnRn (IEVar n)
 774         where
 775           n_mod = moduleName (nameModule n)
 776
 777 rnDump  :: [RenamedHsDecl]      -- Renamed imported decls
 778         -> [RenamedHsDecl]      -- Renamed local decls
 779         -> RnMG ()
 780 rnDump imp_decls local_decls
 781   = doptRn Opt_D_dump_rn_trace  `thenRn` \ dump_rn_trace ->
 782     doptRn Opt_D_dump_rn_stats  `thenRn` \ dump_rn_stats ->
 783     doptRn Opt_D_dump_rn        `thenRn` \ dump_rn ->
 784     getIfacesRn                 `thenRn` \ ifaces ->
 785
 786     ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
 787                             "Renamer statistics"
 788                             (getRnStats imp_decls ifaces) ;
 789
 790                   dumpIfSet dump_rn "Renamer:"
 791                             (vcat (map ppr (local_decls ++ imp_decls)))
 792     })                          `thenRn_`
 793
 794     returnRn ()
 795 \end{code}
 796
 797
 798 %*********************************************************
 799 %*                                                      *
 800 \subsection{Statistics}
 801 %*                                                      *
 802 %*********************************************************
 803
 804 \begin{code}
 805 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
 806 getRnStats imported_decls ifaces
 807   = hcat [text "Renamer stats: ", stats]
 808   where
 809     n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
 810         -- This is really only right for a one-shot compile
 811
 812     (decls_map, n_decls_slurped) = iDecls ifaces
 813
 814     n_decls_left   = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
 815                         -- Data, newtype, and class decls are in the decls_fm
 816                         -- under multiple names; the tycon/class, and each
 817                         -- constructor/class op too.
 818                         -- The 'True' selects just the 'main' decl
 819                      ]
 820
 821     (insts_left, n_insts_slurped) = iInsts ifaces
 822     n_insts_left  = length (bagToList insts_left)
 823
 824     (rules_left, n_rules_slurped) = iRules ifaces
 825     n_rules_left  = length (bagToList rules_left)
 826
 827     stats = vcat
 828         [int n_mods <+> text "interfaces read",
 829          hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
 830                 int (n_decls_slurped + n_decls_left), text "read"],
 831          hsep [ int n_insts_slurped, text "instance decls imported, out of",
 832                 int (n_insts_slurped + n_insts_left), text "read"],
 833          hsep [ int n_rules_slurped, text "rule decls imported, out of",
 834                 int (n_rules_slurped + n_rules_left), text "read"]
 835         ]
 836 \end{code}
 837
 838
 839 %************************************************************************
 840 %*                                                                      *
 841 \subsection{Errors and warnings}
 842 %*                                                                      *
 843 %************************************************************************
 844
 845 \begin{code}
 846 dupFixityDecl rdr_name loc1 loc2
 847   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 848           ptext SLIT("at ") <+> ppr loc1,
 849           ptext SLIT("and") <+> ppr loc2]
 850
 851 badDeprec d
 852   = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
 853          nest 4 (ppr d)]
 854 \end{code}
 855
 856