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