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