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