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