ghc/compiler/rename/Rename.lhs

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