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                            traceRn (text "Bad old interface file" $$ nest 4 err) `thenRn_`
 417                            returnRn (outOfDate, Nothing)
 418
 419                Right parsed_iface
 420                       -> setModuleRn (pi_mod parsed_iface) $
 421                          loadOldIface parsed_iface `thenRn` \ m_iface ->
 422                          check_versions m_iface
 423     where
 424        check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
 425        check_versions iface
 426           | not source_unchanged
 427           = returnRn (outOfDate, Just iface)
 428           | otherwise
 429           = -- Check versions
 430             recompileRequired iface_path iface  `thenRn` \ recompile ->
 431             returnRn (recompile, Just iface)
 432 \end{code}
 433
 434 I think the following function should now have a more representative name,
 435 but what?
 436
 437 \begin{code}
 438 loadOldIface :: ParsedIface -> RnMG ModIface
 439
 440 loadOldIface parsed_iface
 441   = let iface = parsed_iface
 442         mod = pi_mod iface
 443     in
 444     initIfaceRnMS mod (
 445         loadHomeDecls (pi_decls iface)  `thenRn` \ decls ->
 446         loadHomeRules (pi_rules iface)  `thenRn` \ rules ->
 447         loadHomeInsts (pi_insts iface)  `thenRn` \ insts ->
 448         returnRn (decls, rules, insts)
 449     )
 450         `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
 451
 452     mapRn loadHomeUsage (pi_usages iface)       `thenRn` \ usages ->
 453     loadExports         (pi_exports iface)      `thenRn` \ (export_vers, avails) ->
 454     loadFixDecls mod    (pi_fixity iface)       `thenRn` \ fix_env ->
 455     loadDeprecs mod     (pi_deprecs iface)      `thenRn` \ deprec_env ->
 456     let
 457         version = VersionInfo { vers_module  = pi_vers iface,
 458                                 vers_exports = export_vers,
 459                                 vers_rules   = rule_vers,
 460                                 vers_decls   = decls_vers }
 461
 462         decls = mkIfaceDecls new_decls new_rules new_insts
 463
 464         mod_iface = ModIface { mi_module = mod, mi_version = version,
 465                                mi_exports = avails, mi_usages  = usages,
 466                                mi_boot = False, mi_orphan = pi_orphan iface,
 467                                mi_fixities = fix_env, mi_deprecs = deprec_env,
 468                                mi_decls   = decls,
 469                                mi_globals = mkIfaceGlobalRdrEnv avails
 470                     }
 471     in
 472     returnRn mod_iface
 473 \end{code}
 474
 475 \begin{code}
 476 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
 477               -> RnMS (NameEnv Version, [RenamedTyClDecl])
 478 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
 479
 480 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
 481              -> (Version, RdrNameTyClDecl)
 482              -> RnMS (NameEnv Version, [RenamedTyClDecl])
 483 loadHomeDecl (version_map, decls) (version, decl)
 484   = rnTyClDecl decl     `thenRn` \ decl' ->
 485     returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
 486
 487 ------------------
 488 loadHomeRules :: (Version, [RdrNameRuleDecl])
 489               -> RnMS (Version, [RenamedRuleDecl])
 490 loadHomeRules (version, rules)
 491   = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
 492     returnRn (version, rules')
 493
 494 ------------------
 495 loadHomeInsts :: [RdrNameInstDecl]
 496               -> RnMS [RenamedInstDecl]
 497 loadHomeInsts insts = mapRn rnInstDecl insts
 498
 499 ------------------
 500 loadHomeUsage :: ImportVersion OccName
 501               -> RnMG (ImportVersion Name)
 502 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
 503   = rn_imps whats_imported      `thenRn` \ whats_imported' ->
 504     returnRn (mod_name, orphans, is_boot, whats_imported')
 505   where
 506     rn_imps NothingAtAll                  = returnRn NothingAtAll
 507     rn_imps (Everything v)                = returnRn (Everything v)
 508     rn_imps (Specifically mv ev items rv) = mapRn rn_imp items  `thenRn` \ items' ->
 509                                             returnRn (Specifically mv ev items' rv)
 510     rn_imp (occ,vers) = newGlobalName mod_name occ      `thenRn` \ name ->
 511                         returnRn (name,vers)
 512 \end{code}
 513
 514
 515
 516 %*********************************************************
 517 %*                                                       *
 518 \subsection{Closing up the interface decls}
 519 %*                                                       *
 520 %*********************************************************
 521
 522 Suppose we discover we don't need to recompile.   Then we start from the
 523 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
 524
 525 \begin{code}
 526 closeIfaceDecls :: DynFlags
 527                 -> HomeIfaceTable -> HomeSymbolTable
 528                 -> PersistentCompilerState
 529                 -> ModIface     -- Get the decls from here
 530                 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
 531                                 -- True <=> errors happened
 532 closeIfaceDecls dflags hit hst pcs
 533                 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
 534   = runRn dflags hit hst pcs mod $
 535
 536     let
 537         rule_decls = dcl_rules iface_decls
 538         inst_decls = dcl_insts iface_decls
 539         tycl_decls = dcl_tycl  iface_decls
 540         decls = map RuleD rule_decls ++
 541                 map InstD inst_decls ++
 542                 map TyClD tycl_decls
 543         needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
 544                  unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
 545                  unionManyNameSets (map tyClDeclFVs tycl_decls)
 546         local_names    = foldl add emptyNameSet tycl_decls
 547         add names decl = addListToNameSet names (map fst (tyClDeclSysNames decl ++ tyClDeclNames decl))
 548     in
 549
 550     recordLocalSlurps local_names       `thenRn_`
 551
 552         -- Do the transitive closure
 553     closeDecls decls (needed `plusFV` implicit_fvs) `thenRn` \closed_decls ->
 554     rnDump [] closed_decls `thenRn_`
 555     returnRn closed_decls
 556   where
 557     implicit_fvs = ubiquitousNames      -- Data type decls with record selectors,
 558                                         -- which may appear in the decls, need unpackCString
 559                                         -- and friends. It's easier to just grab them right now.
 560 \end{code}
 561
 562 %*********************************************************
 563 %*                                                       *
 564 \subsection{Unused names}
 565 %*                                                       *
 566 %*********************************************************
 567
 568 \begin{code}
 569 reportUnusedNames :: ModIface -> PrintUnqualified
 570                   -> [RdrNameImportDecl]
 571                   -> AvailEnv
 572                   -> NameSet            -- Used in this module
 573                   -> [RenamedHsDecl]
 574                   -> RnMG ()
 575 reportUnusedNames my_mod_iface unqual imports avail_env
 576                   used_names imported_decls
 577   = warnUnusedModules unused_imp_mods                           `thenRn_`
 578     warnUnusedLocalBinds bad_locals                             `thenRn_`
 579     warnUnusedImports bad_imp_names                             `thenRn_`
 580     printMinimalImports this_mod unqual minimal_imports
 581   where
 582     this_mod   = mi_module my_mod_iface
 583     gbl_env    = mi_globals my_mod_iface
 584
 585     -- Now, a use of C implies a use of T,
 586     -- if C was brought into scope by T(..) or T(C)
 587     really_used_names = used_names `unionNameSets`
 588       mkNameSet [ parent_name
 589                 | sub_name <- nameSetToList used_names
 590
 591                 -- Usually, every used name will appear in avail_env, but there
 592                 -- is one time when it doesn't: tuples and other built in syntax.  When you
 593                 -- write (a,b) that gives rise to a *use* of "(,)", so that the
 594                 -- instances will get pulled in, but the tycon "(,)" isn't actually
 595                 -- in scope.  Also, (-x) gives rise to an implicit use of 'negate';
 596                 -- similarly,   3.5 gives rise to an implcit use of :%
 597                 -- Hence the silent 'False' in all other cases
 598
 599                 , Just parent_name <- [case lookupNameEnv avail_env sub_name of
 600                                         Just (AvailTC n _) -> Just n
 601                                         other              -> Nothing]
 602             ]
 603
 604         -- Collect the defined names from the in-scope environment
 605         -- Look for the qualified ones only, else get duplicates
 606     defined_names :: [GlobalRdrElt]
 607     defined_names = foldRdrEnv add [] gbl_env
 608     add rdr_name ns acc | isQual rdr_name = ns ++ acc
 609                         | otherwise       = acc
 610
 611     defined_and_used, defined_but_not_used :: [GlobalRdrElt]
 612     (defined_and_used, defined_but_not_used) = partition used defined_names
 613     used (GRE name _ _)                      = name `elemNameSet` really_used_names
 614
 615     -- Filter out the ones only defined implicitly
 616     bad_locals :: [Name]
 617     bad_locals = [n | (GRE n LocalDef _) <- defined_but_not_used]
 618
 619     bad_imp_names :: [(Name,Provenance)]
 620     bad_imp_names  = [(n,p) | GRE n p@(NonLocalDef (UserImport mod _ True)) _ <- defined_but_not_used,
 621                               not (module_unused mod)]
 622
 623     -- inst_mods are directly-imported modules that
 624     --  contain instance decl(s) that the renamer decided to suck in
 625     -- It's not necessarily redundant to import such modules.
 626     --
 627     -- NOTE: Consider
 628     --        module This
 629     --          import M ()
 630     --
 631     --   The import M() is not *necessarily* redundant, even if
 632     --   we suck in no instance decls from M (e.g. it contains
 633     --   no instance decls, or This contains no code).  It may be
 634     --   that we import M solely to ensure that M's orphan instance
 635     --   decls (or those in its imports) are visible to people who
 636     --   import This.  Sigh.
 637     --   There's really no good way to detect this, so the error message
 638     --   in RnEnv.warnUnusedModules is weakened instead
 639     inst_mods :: [ModuleName]
 640     inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
 641                  let m = moduleName (nameModule dfun),
 642                  m `elem` direct_import_mods
 643             ]
 644
 645     -- To figure out the minimal set of imports, start with the things
 646     -- that are in scope (i.e. in gbl_env).  Then just combine them
 647     -- into a bunch of avails, so they are properly grouped
 648     minimal_imports :: FiniteMap ModuleName AvailEnv
 649     minimal_imports0 = emptyFM
 650     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
 651     minimal_imports  = foldr add_inst_mod minimal_imports1 inst_mods
 652
 653         -- We've carefully preserved the provenance so that we can
 654         -- construct minimal imports that import the name by (one of)
 655         -- the same route(s) as the programmer originally did.
 656     add_name (GRE n (NonLocalDef (UserImport m _ _)) _) acc = addToFM_C plusAvailEnv acc (moduleName m)
 657                                                                         (unitAvailEnv (mk_avail n))
 658     add_name (GRE n other_prov _)                       acc = acc
 659
 660     mk_avail n = case lookupNameEnv avail_env n of
 661                 Just (AvailTC m _) | n==m      -> AvailTC n [n]
 662                                    | otherwise -> AvailTC m [n,m]
 663                 Just avail         -> Avail n
 664                 Nothing            -> pprPanic "mk_avail" (ppr n)
 665
 666     add_inst_mod m acc
 667       | m `elemFM` acc = acc    -- We import something already
 668       | otherwise      = addToFM acc m emptyAvailEnv
 669         -- Add an empty collection of imports for a module
 670         -- from which we have sucked only instance decls
 671
 672     direct_import_mods :: [ModuleName]
 673     direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
 674
 675     -- unused_imp_mods are the directly-imported modules
 676     -- that are not mentioned in minimal_imports
 677     unused_imp_mods = [m | m <- direct_import_mods,
 678                        not (maybeToBool (lookupFM minimal_imports m)),
 679                        m /= pRELUDE_Name]
 680
 681     module_unused :: Module -> Bool
 682     module_unused mod = moduleName mod `elem` unused_imp_mods
 683
 684
 685 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
 686 printMinimalImports :: Module   -- This module
 687                     -> PrintUnqualified
 688                     -> FiniteMap ModuleName AvailEnv    -- Minimal imports
 689                     -> RnMG ()
 690 printMinimalImports this_mod unqual imps
 691   = ifOptRn Opt_D_dump_minimal_imports          $
 692
 693     mapRn to_ies (fmToList imps)                `thenRn` \ mod_ies ->
 694     ioToRnM (do { h <- openFile filename WriteMode ;
 695                   printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
 696         })                                      `thenRn_`
 697     returnRn ()
 698   where
 699     filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
 700     ppr_mod_ie (mod_name, ies)
 701         | mod_name == pRELUDE_Name
 702         = empty
 703         | otherwise
 704         = ptext SLIT("import") <+> ppr mod_name <>
 705                             parens (fsep (punctuate comma (map ppr ies)))
 706
 707     to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)      `thenRn` \ ies ->
 708                               returnRn (mod, ies)
 709
 710     to_ie :: AvailInfo -> RnMG (IE Name)
 711         -- The main trick here is that if we're importing all the constructors
 712         -- we want to say "T(..)", but if we're importing only a subset we want
 713         -- to say "T(A,B,C)".  So we have to find out what the module exports.
 714     to_ie (Avail n)       = returnRn (IEVar n)
 715     to_ie (AvailTC n [m]) = ASSERT( n==m )
 716                             returnRn (IEThingAbs n)
 717     to_ie (AvailTC n ns)
 718         = loadInterface (text "Compute minimal imports from" <+> ppr n_mod) n_mod ImportBySystem        `thenRn` \ iface ->
 719           case [xs | (m,as) <- mi_exports iface,
 720                      m == n_mod,
 721                      AvailTC x xs <- as,
 722                      x == n] of
 723               [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
 724                    | otherwise          -> returnRn (IEThingWith n (filter (/= n) ns))
 725               other                     -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
 726                                            returnRn (IEVar n)
 727         where
 728           n_mod = moduleName (nameModule n)
 729
 730 rnDump  :: [RenamedHsDecl]      -- Renamed imported decls
 731         -> [RenamedHsDecl]      -- Renamed local decls
 732         -> RnMG ()
 733 rnDump imp_decls local_decls
 734   = doptRn Opt_D_dump_rn_trace  `thenRn` \ dump_rn_trace ->
 735     doptRn Opt_D_dump_rn_stats  `thenRn` \ dump_rn_stats ->
 736     doptRn Opt_D_dump_rn        `thenRn` \ dump_rn ->
 737     getIfacesRn                 `thenRn` \ ifaces ->
 738
 739     ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
 740                             "Renamer statistics"
 741                             (getRnStats imp_decls ifaces) ;
 742
 743                   dumpIfSet dump_rn "Renamer:"
 744                             (vcat (map ppr (local_decls ++ imp_decls)))
 745     })                          `thenRn_`
 746
 747     returnRn ()
 748 \end{code}
 749
 750
 751 %*********************************************************
 752 %*                                                      *
 753 \subsection{Statistics}
 754 %*                                                      *
 755 %*********************************************************
 756
 757 \begin{code}
 758 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
 759 getRnStats imported_decls ifaces
 760   = hcat [text "Renamer stats: ", stats]
 761   where
 762     n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
 763         -- This is really only right for a one-shot compile
 764
 765     (decls_map, n_decls_slurped) = iDecls ifaces
 766
 767     n_decls_left   = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
 768                         -- Data, newtype, and class decls are in the decls_fm
 769                         -- under multiple names; the tycon/class, and each
 770                         -- constructor/class op too.
 771                         -- The 'True' selects just the 'main' decl
 772                      ]
 773
 774     (insts_left, n_insts_slurped) = iInsts ifaces
 775     n_insts_left  = length (bagToList insts_left)
 776
 777     (rules_left, n_rules_slurped) = iRules ifaces
 778     n_rules_left  = length (bagToList rules_left)
 779
 780     stats = vcat
 781         [int n_mods <+> text "interfaces read",
 782          hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
 783                 int (n_decls_slurped + n_decls_left), text "read"],
 784          hsep [ int n_insts_slurped, text "instance decls imported, out of",
 785                 int (n_insts_slurped + n_insts_left), text "read"],
 786          hsep [ int n_rules_slurped, text "rule decls imported, out of",
 787                 int (n_rules_slurped + n_rules_left), text "read"]
 788         ]
 789 \end{code}
 790
 791
 792 %************************************************************************
 793 %*                                                                      *
 794 \subsection{Errors and warnings}
 795 %*                                                                      *
 796 %************************************************************************
 797
 798 \begin{code}
 799 dupFixityDecl rdr_name loc1 loc2
 800   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 801           ptext SLIT("at ") <+> ppr loc1,
 802           ptext SLIT("and") <+> ppr loc2]
 803
 804 badDeprec d
 805   = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
 806          nest 4 (ppr d)]
 807 \end{code}
 808
 809