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