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