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