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