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