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