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,
  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        ( 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(..), GhciMode(..),
  66                           LocalRdrEnv
  67                          )
  68 import List             ( partition, nub )
  69 \end{code}
  70
  71
  72
  73
  74 %*********************************************************
  75 %*                                                       *
  76 \subsection{The two main wrappers}
  77 %*                                                       *
  78 %*********************************************************
  79
  80 \begin{code}
  81 renameModule :: DynFlags
  82              -> HomeIfaceTable -> HomeSymbolTable
  83              -> PersistentCompilerState
  84              -> Module -> RdrNameHsModule
  85              -> IO (PersistentCompilerState, PrintUnqualified,
  86                     Maybe (IsExported, ModIface, [RenamedHsDecl]))
  87         -- Nothing => some error occurred in the renamer
  88
  89 renameModule dflags hit hst pcs this_module rdr_module
  90   = renameSource dflags hit hst pcs this_module $
  91     rename this_module rdr_module
  92 \end{code}
  93
  94
  95 \begin{code}
  96 renameStmt :: DynFlags
  97            -> HomeIfaceTable -> HomeSymbolTable
  98            -> PersistentCompilerState
  99            -> Module                    -- current context (scope to compile in)
 100            -> Module                    -- current module
 101            -> LocalRdrEnv               -- current context (temp bindings)
 102            -> RdrNameStmt               -- parsed stmt
 103            -> IO ( PersistentCompilerState,
 104                    PrintUnqualified,
 105                    Maybe ([Name], (RenamedStmt, [RenamedHsDecl]))
 106                  )
 107
 108 renameStmt dflags hit hst pcs scope_module this_module local_env stmt
 109   = renameSource dflags hit hst pcs this_module $
 110
 111         -- Load the interface for the context module, so
 112         -- that we can get its top-level lexical environment
 113         -- Bale out if we fail to do this
 114     loadInterface doc (moduleName scope_module) ImportByUser `thenRn` \ iface ->
 115     let rdr_env       = mi_globals iface
 116         print_unqual  = unQualInScope rdr_env
 117     in
 118     checkErrsRn                         `thenRn` \ no_errs_so_far ->
 119     if not no_errs_so_far then
 120         returnRn (print_unqual, Nothing)
 121     else
 122
 123         -- Rename it
 124     initRnMS rdr_env local_env emptyLocalFixityEnv CmdLineMode (
 125         rnStmt stmt     $ \ stmt' ->
 126         returnRn (([], stmt'), emptyFVs)
 127     )                                           `thenRn` \ ((binders, stmt), fvs) ->
 128
 129         -- Bale out if we fail
 130     checkErrsRn                                 `thenRn` \ no_errs_so_far ->
 131     if not no_errs_so_far then
 132         doDump [] stmt [] `thenRn_` returnRn (print_unqual, Nothing)
 133     else
 134
 135         -- Add implicit free vars, and close decls
 136     getImplicitStmtFVs                          `thenRn` \ implicit_fvs ->
 137     let
 138         filtered_fvs = fvs `delListFromNameSet` rdrEnvElts local_env
 139         source_fvs   = implicit_fvs `plusFV` filtered_fvs
 140     in
 141     slurpImpDecls source_fvs                    `thenRn` \ decls ->
 142
 143     doDump binders stmt decls  `thenRn_`
 144     returnRn (print_unqual, Just (binders, (stmt, decls)))
 145
 146   where
 147      doc = text "context for compiling expression"
 148
 149      doDump :: [Name] -> RenamedStmt -> [RenamedHsDecl] -> RnMG (Either IOError ())
 150      doDump bndrs stmt decls
 151         = getDOptsRn  `thenRn` \ dflags ->
 152           ioToRnM (dumpIfSet_dyn dflags Opt_D_dump_rn "Renamer:"
 153                         (vcat [text "Binders:" <+> ppr bndrs,
 154                                ppr stmt, text "",
 155                                vcat (map ppr decls)]))
 156 \end{code}
 157
 158
 159 %*********************************************************
 160 %*                                                       *
 161 \subsection{The main function: rename}
 162 %*                                                       *
 163 %*********************************************************
 164
 165 \begin{code}
 166 renameSource :: DynFlags
 167              -> HomeIfaceTable -> HomeSymbolTable
 168              -> PersistentCompilerState
 169              -> Module
 170              -> RnMG (PrintUnqualified, Maybe r)
 171              -> IO (PersistentCompilerState, PrintUnqualified, Maybe r)
 172         -- Nothing => some error occurred in the renamer
 173
 174 renameSource dflags hit hst old_pcs this_module thing_inside
 175   = do  { showPass dflags "Renamer"
 176
 177                 -- Initialise the renamer monad
 178         ; (new_pcs, msgs, (print_unqual, maybe_rn_stuff))
 179                 <- initRn dflags hit hst old_pcs this_module thing_inside
 180
 181                 -- Print errors from renaming
 182         ;  printErrorsAndWarnings print_unqual msgs ;
 183
 184                 -- Return results.  No harm in updating the PCS
 185         ; if errorsFound msgs then
 186             return (new_pcs, print_unqual, Nothing)
 187           else
 188             return (new_pcs, print_unqual, maybe_rn_stuff)
 189     }
 190 \end{code}
 191
 192 \begin{code}
 193 rename :: Module -> RdrNameHsModule
 194        -> RnMG (PrintUnqualified, Maybe (IsExported, ModIface, [RenamedHsDecl]))
 195 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
 196   = pushSrcLocRn loc            $
 197
 198         -- FIND THE GLOBAL NAME ENVIRONMENT
 199     getGlobalNames this_module contents         `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
 200     let
 201         print_unqualified = unQualInScope gbl_env
 202     in
 203         -- Exit if we've found any errors
 204     checkErrsRn                         `thenRn` \ no_errs_so_far ->
 205     if not no_errs_so_far then
 206         -- Found errors already, so exit now
 207         rnDump [] []            `thenRn_`
 208         returnRn (print_unqualified, Nothing)
 209     else
 210
 211         -- PROCESS EXPORT LIST
 212     exportsFromAvail mod_name exports all_avails gbl_env        `thenRn` \ export_avails ->
 213
 214     traceRn (text "Local top-level environment" $$
 215              nest 4 (pprGlobalRdrEnv local_gbl_env))    `thenRn_`
 216
 217         -- DEAL WITH DEPRECATIONS
 218     rnDeprecs local_gbl_env mod_deprec
 219               [d | DeprecD d <- local_decls]            `thenRn` \ my_deprecs ->
 220
 221         -- DEAL WITH LOCAL FIXITIES
 222     fixitiesFromLocalDecls local_gbl_env local_decls    `thenRn` \ local_fixity_env ->
 223
 224         -- RENAME THE SOURCE
 225     rnSourceDecls gbl_env local_fixity_env local_decls  `thenRn` \ (rn_local_decls, source_fvs) ->
 226
 227         -- EXIT IF ERRORS FOUND
 228         -- We exit here if there are any errors in the source, *before*
 229         -- we attempt to slurp the decls from the interfaces, otherwise
 230         -- the slurped decls may get lost when we return up the stack
 231         -- to hscMain/hscExpr.
 232     checkErrsRn                                 `thenRn` \ no_errs_so_far ->
 233     if not no_errs_so_far then
 234         -- Found errors already, so exit now
 235         rnDump [] rn_local_decls                `thenRn_`
 236         returnRn (print_unqualified, Nothing)
 237     else
 238
 239         -- SLURP IN ALL THE NEEDED DECLARATIONS
 240         -- Find out what re-bindable names to use for desugaring
 241     getImplicitModuleFVs mod_name rn_local_decls        `thenRn` \ implicit_fvs ->
 242     let
 243         export_fvs  = availsToNameSet export_avails
 244         source_fvs2 = source_fvs `plusFV` export_fvs
 245                 -- The export_fvs make the exported names look just as if they
 246                 -- occurred in the source program.  For the reasoning, see the
 247                 -- comments with RnIfaces.mkImportInfo
 248                 -- It also helps reportUnusedNames, which of course must not complain
 249                 -- that 'f' isn't mentioned if it is mentioned in the export list
 250
 251         source_fvs3 = implicit_fvs `plusFV` source_fvs2
 252                 -- It's important to do the "plus" this way round, so that
 253                 -- when compiling the prelude, locally-defined (), Bool, etc
 254                 -- override the implicit ones.
 255
 256     in
 257     traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList source_fvs3))) `thenRn_`
 258     slurpImpDecls source_fvs3                   `thenRn` \ rn_imp_decls ->
 259     rnDump rn_imp_decls rn_local_decls          `thenRn_`
 260
 261         -- GENERATE THE VERSION/USAGE INFO
 262     mkImportInfo mod_name imports               `thenRn` \ my_usages ->
 263
 264         -- BUILD THE MODULE INTERFACE
 265     let
 266         -- We record fixities even for things that aren't exported,
 267         -- so that we can change into the context of this moodule easily
 268         fixities = mkNameEnv [ (name, fixity)
 269                              | FixitySig name fixity loc <- nameEnvElts local_fixity_env
 270                              ]
 271
 272         -- Sort the exports to make them easier to compare for versions
 273         my_exports = groupAvails this_module export_avails
 274
 275         final_decls = rn_local_decls ++ rn_imp_decls
 276
 277         mod_iface = ModIface {  mi_module   = this_module,
 278                                 mi_version  = initialVersionInfo,
 279                                 mi_usages   = my_usages,
 280                                 mi_boot     = False,
 281                                 mi_orphan   = panic "is_orphan",
 282                                 mi_exports  = my_exports,
 283                                 mi_globals  = gbl_env,
 284                                 mi_fixities = fixities,
 285                                 mi_deprecs  = my_deprecs,
 286                                 mi_decls    = panic "mi_decls"
 287                     }
 288
 289         is_exported name  = name `elemNameSet` exported_names
 290         exported_names    = availsToNameSet export_avails
 291     in
 292
 293         -- REPORT UNUSED NAMES, AND DEBUG DUMP
 294     reportUnusedNames mod_iface print_unqualified
 295                       imports global_avail_env
 296                       source_fvs2 rn_imp_decls          `thenRn_`
 297                 -- NB: source_fvs2: include exports (else we get bogus
 298                 --     warnings of unused things) but not implicit FVs.
 299
 300     returnRn (print_unqualified, Just (is_exported, mod_iface, final_decls))
 301   where
 302     mod_name = moduleName this_module
 303 \end{code}
 304
 305
 306
 307 %*********************************************************
 308 %*                                                       *
 309 \subsection{Fixities}
 310 %*                                                       *
 311 %*********************************************************
 312
 313 \begin{code}
 314 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
 315 fixitiesFromLocalDecls gbl_env decls
 316   = foldlRn getFixities emptyNameEnv decls                              `thenRn` \ env ->
 317     traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))    `thenRn_`
 318     returnRn env
 319   where
 320     getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
 321     getFixities acc (FixD fix)
 322       = fix_decl acc fix
 323
 324     getFixities acc (TyClD (ClassDecl { tcdSigs = sigs}))
 325       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
 326                 -- Get fixities from class decl sigs too.
 327     getFixities acc other_decl
 328       = returnRn acc
 329
 330     fix_decl acc sig@(FixitySig rdr_name fixity loc)
 331         =       -- Check for fixity decl for something not declared
 332           pushSrcLocRn loc                      $
 333           lookupSrcName gbl_env rdr_name        `thenRn` \ name ->
 334
 335                 -- Check for duplicate fixity decl
 336           case lookupNameEnv acc name of
 337             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')     `thenRn_`
 338                                          returnRn acc ;
 339
 340             Nothing                   -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
 341 \end{code}
 342
 343
 344 %*********************************************************
 345 %*                                                       *
 346 \subsection{Deprecations}
 347 %*                                                       *
 348 %*********************************************************
 349
 350 For deprecations, all we do is check that the names are in scope.
 351 It's only imported deprecations, dealt with in RnIfaces, that we
 352 gather them together.
 353
 354 \begin{code}
 355 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
 356            -> [RdrNameDeprecation] -> RnMG Deprecations
 357 rnDeprecs gbl_env Nothing []
 358  = returnRn NoDeprecs
 359
 360 rnDeprecs gbl_env (Just txt) decls
 361  = mapRn (addErrRn . badDeprec) decls   `thenRn_`
 362    returnRn (DeprecAll txt)
 363
 364 rnDeprecs gbl_env Nothing decls
 365   = mapRn rn_deprec decls       `thenRn` \ pairs ->
 366     returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
 367  where
 368    rn_deprec (Deprecation rdr_name txt loc)
 369      = pushSrcLocRn loc                         $
 370        lookupSrcName gbl_env rdr_name           `thenRn` \ name ->
 371        returnRn (Just (name, (name,txt)))
 372 \end{code}
 373
 374
 375 %************************************************************************
 376 %*                                                                      *
 377 \subsection{Grabbing the old interface file and checking versions}
 378 %*                                                                      *
 379 %************************************************************************
 380
 381 \begin{code}
 382 checkOldIface :: GhciMode
 383               -> DynFlags
 384               -> HomeIfaceTable -> HomeSymbolTable
 385               -> PersistentCompilerState
 386               -> FilePath
 387               -> Bool                   -- Source unchanged
 388               -> Maybe ModIface         -- Old interface from compilation manager, if any
 389               -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
 390                                 -- True <=> errors happened
 391
 392 checkOldIface ghci_mode dflags hit hst pcs iface_path source_unchanged maybe_iface
 393     = runRn dflags hit hst pcs (panic "Bogus module") $
 394
 395         -- CHECK WHETHER THE SOURCE HAS CHANGED
 396     ( if not source_unchanged then
 397         traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off"))
 398       else returnRn () )   `thenRn_`
 399
 400      -- If the source has changed and we're in interactive mode, avoid reading
 401      -- an interface; just return the one we might have been supplied with.
 402     if ghci_mode == Interactive && not source_unchanged then
 403          returnRn (outOfDate, maybe_iface)
 404     else
 405
 406     case maybe_iface of
 407        Just old_iface -> -- Use the one we already have
 408                          setModuleRn (mi_module old_iface) (check_versions old_iface)
 409
 410        Nothing -- try and read it from a file
 411           -> readIface iface_path       `thenRn` \ read_result ->
 412              case read_result of
 413                Left err -> -- Old interface file not found, or garbled; give up
 414                            traceHiDiffsRn (
 415                                 text "Cannot read old interface file:"
 416                                    $$ 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