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