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