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