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