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