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