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