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