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