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