ghc/compiler/rename/Rename.lhs

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