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