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