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