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