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