ghc/compiler/rename/Rename.lhs

   1 %
   2 % (c) The GRASP Project, Glasgow University, 1992-1998
   3 %
   4 \section[Rename]{Renaming and dependency analysis passes}
   5
   6 \begin{code}
   7 module Rename ( renameModule, renameExpr, closeIfaceDecls, checkOldIface ) where
   8
   9 #include "HsVersions.h"
  10
  11 import HsSyn
  12 import RdrHsSyn         ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation, RdrNameHsExpr,
  13                           RdrNameTyClDecl, RdrNameRuleDecl, RdrNameInstDecl, RdrNameImportDecl
  14                         )
  15 import RnHsSyn          ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDecl,
  16                           extractHsTyNames, RenamedHsExpr,
  17                           instDeclFVs, tyClDeclFVs, ruleDeclFVs
  18                         )
  19
  20 import CmdLineOpts      ( DynFlags, DynFlag(..) )
  21 import RnMonad
  22 import RnExpr           ( rnExpr )
  23 import RnNames          ( getGlobalNames, exportsFromAvail )
  24 import RnSource         ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
  25 import RnIfaces         ( slurpImpDecls, mkImportInfo,
  26                           getInterfaceExports, closeDecls,
  27                           RecompileRequired, outOfDate, recompileRequired
  28                         )
  29 import RnHiFiles        ( readIface, removeContext, loadInterface,
  30                           loadExports, loadFixDecls, loadDeprecs )
  31 import RnEnv            ( availsToNameSet, availName,
  32                           emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
  33                           warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
  34                           lookupOrigNames, lookupSrcName, newGlobalName, unQualInScope
  35                         )
  36 import Module           ( Module, ModuleName, WhereFrom(..),
  37                           moduleNameUserString, moduleName,
  38                           moduleEnvElts, lookupModuleEnv
  39                         )
  40 import Name             ( Name, NamedThing(..), getSrcLoc,
  41                           nameIsLocalOrFrom, nameOccName, nameModule,
  42                         )
  43 import Name             ( mkNameEnv, nameEnvElts, extendNameEnv )
  44 import RdrName          ( elemRdrEnv, foldRdrEnv, isQual )
  45 import OccName          ( occNameFlavour )
  46 import NameSet
  47 import TysWiredIn       ( unitTyCon, intTyCon, boolTyCon )
  48 import PrelNames        ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
  49                           ioTyCon_RDR, main_RDR_Unqual,
  50                           unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
  51                           eqString_RDR
  52                         )
  53 import PrelInfo         ( derivingOccurrences )
  54 import Type             ( funTyCon )
  55 import ErrUtils         ( dumpIfSet, showPass, printErrorsAndWarnings, errorsFound )
  56 import Bag              ( bagToList )
  57 import FiniteMap        ( FiniteMap, fmToList, emptyFM, lookupFM,
  58                           addToFM_C, elemFM, addToFM
  59                         )
  60 import UniqFM           ( lookupUFM )
  61 import Maybes           ( maybeToBool, catMaybes )
  62 import Outputable
  63 import IO               ( openFile, IOMode(..) )
  64 import HscTypes         ( PersistentCompilerState, HomeIfaceTable, HomeSymbolTable,
  65                           ModIface(..), WhatsImported(..),
  66                           VersionInfo(..), ImportVersion, IsExported,
  67                           IfaceDecls, mkIfaceDecls, dcl_tycl, dcl_rules, dcl_insts,
  68                           GlobalRdrEnv, pprGlobalRdrEnv,
  69                           AvailEnv, GenAvailInfo(..), AvailInfo, Avails,
  70                           Provenance(..), ImportReason(..), initialVersionInfo,
  71                           Deprecations(..), lookupDeprec, lookupIface
  72                          )
  73 import List             ( partition, nub )
  74 \end{code}
  75
  76
  77
  78
  79 %*********************************************************
  80 %*                                                       *
  81 \subsection{The two main wrappers}
  82 %*                                                       *
  83 %*********************************************************
  84
  85 \begin{code}
  86 renameModule :: DynFlags
  87              -> HomeIfaceTable -> HomeSymbolTable
  88              -> PersistentCompilerState
  89              -> Module -> RdrNameHsModule
  90              -> IO (PersistentCompilerState, Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
  91         -- Nothing => some error occurred in the renamer
  92
  93 renameModule dflags hit hst pcs this_module rdr_module
  94   = renameSource dflags hit hst pcs this_module $
  95     rename this_module rdr_module
  96 \end{code}
  97
  98
  99 \begin{code}
 100 renameExpr :: DynFlags
 101            -> HomeIfaceTable -> HomeSymbolTable
 102            -> PersistentCompilerState
 103            -> Module -> RdrNameHsExpr
 104            -> IO (PersistentCompilerState, Maybe (PrintUnqualified, RenamedHsExpr))
 105
 106 renameExpr dflags hit hst pcs this_module expr
 107   | Just iface <- lookupModuleEnv hit this_module
 108   = do  { let rdr_env      = mi_globals iface
 109         ; let print_unqual = unQualInScope rdr_env
 110
 111         ; renameSource dflags hit hst pcs this_module $
 112           initRnMS rdr_env emptyLocalFixityEnv SourceMode $
 113           ( rnExpr expr `thenRn` \ (e,_) ->
 114
 115             doptRn Opt_D_dump_rn `thenRn` \ dump_rn ->
 116             ioToRnM (dumpIfSet dump_rn "Renamer:" (ppr e)) `thenRn_`
 117
 118             returnRn (Just (print_unqual, e)))
 119         }
 120
 121   | otherwise
 122   = do  { printErrs alwaysQualify (ptext SLIT("renameExpr: Bad module context") <+> ppr this_module)
 123         ; return (pcs, Nothing)
 124         }
 125 \end{code}
 126
 127
 128 %*********************************************************
 129 %*                                                       *
 130 \subsection{The main function: rename}
 131 %*                                                       *
 132 %*********************************************************
 133
 134 \begin{code}
 135 renameSource :: DynFlags
 136              -> HomeIfaceTable -> HomeSymbolTable
 137              -> PersistentCompilerState
 138              -> Module
 139              -> RnMG (Maybe (PrintUnqualified, r))
 140              -> IO (PersistentCompilerState, Maybe (PrintUnqualified, r))
 141         -- Nothing => some error occurred in the renamer
 142
 143 renameSource dflags hit hst old_pcs this_module thing_inside
 144   = do  { showPass dflags "Renamer"
 145
 146                 -- Initialise the renamer monad
 147         ; (new_pcs, msgs, maybe_rn_stuff) <- initRn dflags hit hst old_pcs this_module thing_inside
 148
 149                 -- Print errors from renaming
 150         ;  let print_unqual = case maybe_rn_stuff of
 151                                 Just (unqual, _) -> unqual
 152                                 Nothing          -> alwaysQualify
 153
 154         ;  printErrorsAndWarnings print_unqual msgs ;
 155
 156                 -- Return results.  No harm in updating the PCS
 157         ; if errorsFound msgs then
 158             return (new_pcs, Nothing)
 159           else
 160             return (new_pcs, maybe_rn_stuff)
 161     }
 162 \end{code}
 163
 164 \begin{code}
 165 rename :: Module -> RdrNameHsModule -> RnMG (Maybe (PrintUnqualified, (IsExported, ModIface, [RenamedHsDecl])))
 166 rename this_module contents@(HsModule _ _ exports imports local_decls mod_deprec loc)
 167   = pushSrcLocRn loc            $
 168
 169         -- FIND THE GLOBAL NAME ENVIRONMENT
 170     getGlobalNames this_module contents         `thenRn` \ (gbl_env, local_gbl_env, all_avails@(_, global_avail_env)) ->
 171
 172         -- Exit if we've found any errors
 173     checkErrsRn                         `thenRn` \ no_errs_so_far ->
 174     if not no_errs_so_far then
 175         -- Found errors already, so exit now
 176         rnDump [] []            `thenRn_`
 177         returnRn Nothing
 178     else
 179
 180         -- PROCESS EXPORT LIST
 181     exportsFromAvail mod_name exports all_avails gbl_env        `thenRn` \ export_avails ->
 182
 183     traceRn (text "Local top-level environment" $$
 184              nest 4 (pprGlobalRdrEnv local_gbl_env))    `thenRn_`
 185
 186         -- DEAL WITH DEPRECATIONS
 187     rnDeprecs local_gbl_env mod_deprec
 188               [d | DeprecD d <- local_decls]            `thenRn` \ my_deprecs ->
 189
 190         -- DEAL WITH LOCAL FIXITIES
 191     fixitiesFromLocalDecls local_gbl_env local_decls    `thenRn` \ local_fixity_env ->
 192
 193         -- RENAME THE SOURCE
 194     rnSourceDecls gbl_env local_fixity_env local_decls  `thenRn` \ (rn_local_decls, source_fvs) ->
 195
 196         -- CHECK THAT main IS DEFINED, IF REQUIRED
 197     checkMain this_module local_gbl_env         `thenRn_`
 198
 199         -- SLURP IN ALL THE NEEDED DECLARATIONS
 200     implicitFVs mod_name rn_local_decls         `thenRn` \ implicit_fvs ->
 201     let
 202         slurp_fvs = implicit_fvs `plusFV` source_fvs
 203                 -- It's important to do the "plus" this way round, so that
 204                 -- when compiling the prelude, locally-defined (), Bool, etc
 205                 -- override the implicit ones.
 206     in
 207     traceRn (text "Source FVs:" <+> fsep (map ppr (nameSetToList slurp_fvs)))   `thenRn_`
 208     slurpImpDecls slurp_fvs             `thenRn` \ rn_imp_decls ->
 209
 210         -- EXIT IF ERRORS FOUND
 211     rnDump rn_imp_decls rn_local_decls          `thenRn_`
 212     checkErrsRn                                 `thenRn` \ no_errs_so_far ->
 213     if not no_errs_so_far then
 214         -- Found errors already, so exit now
 215         returnRn Nothing
 216     else
 217
 218         -- GENERATE THE VERSION/USAGE INFO
 219     mkImportInfo mod_name imports                       `thenRn` \ my_usages ->
 220
 221         -- BUILD THE MODULE INTERFACE
 222     let
 223         -- We record fixities even for things that aren't exported,
 224         -- so that we can change into the context of this moodule easily
 225         fixities = mkNameEnv [ (name, fixity)
 226                              | FixitySig name fixity loc <- nameEnvElts local_fixity_env
 227                              ]
 228
 229         -- Sort the exports to make them easier to compare for versions
 230         my_exports = groupAvails this_module export_avails
 231
 232         final_decls = rn_local_decls ++ rn_imp_decls
 233         is_orphan   = any (isOrphanDecl this_module) rn_local_decls
 234
 235         mod_iface = ModIface {  mi_module   = this_module,
 236                                 mi_version  = initialVersionInfo,
 237                                 mi_usages   = my_usages,
 238                                 mi_boot     = False,
 239                                 mi_orphan   = is_orphan,
 240                                 mi_exports  = my_exports,
 241                                 mi_globals  = gbl_env,
 242                                 mi_fixities = fixities,
 243                                 mi_deprecs  = my_deprecs,
 244                                 mi_decls    = panic "mi_decls"
 245                     }
 246
 247         print_unqualified = unQualInScope gbl_env
 248         is_exported name  = name `elemNameSet` exported_names
 249         exported_names    = availsToNameSet export_avails
 250     in
 251
 252         -- REPORT UNUSED NAMES, AND DEBUG DUMP
 253     reportUnusedNames mod_iface print_unqualified
 254                       imports global_avail_env
 255                       source_fvs export_avails rn_imp_decls     `thenRn_`
 256
 257     returnRn (Just (print_unqualified, (is_exported, mod_iface, final_decls)))
 258   where
 259     mod_name = moduleName this_module
 260 \end{code}
 261
 262 Checking that main is defined
 263
 264 \begin{code}
 265 checkMain :: Module -> GlobalRdrEnv -> RnMG ()
 266 checkMain this_mod local_env
 267   | moduleName this_mod == mAIN_Name
 268   = checkRn (main_RDR_Unqual `elemRdrEnv` local_env) noMainErr
 269   | otherwise
 270   = returnRn ()
 271 \end{code}
 272
 273 @implicitFVs@ forces the renamer to slurp in some things which aren't
 274 mentioned explicitly, but which might be needed by the type checker.
 275
 276 \begin{code}
 277 implicitFVs mod_name decls
 278   = lookupOrigNames implicit_occs                       `thenRn` \ implicit_names ->
 279     returnRn (mkNameSet (map getName default_tycons)    `plusFV`
 280               implicit_names)
 281   where
 282         -- Add occurrences for Int, and (), because they
 283         -- are the types to which ambigious type variables may be defaulted by
 284         -- the type checker; so they won't always appear explicitly.
 285         -- [The () one is a GHC extension for defaulting CCall results.]
 286         -- ALSO: funTyCon, since it occurs implicitly everywhere!
 287         --       (we don't want to be bothered with making funTyCon a
 288         --        free var at every function application!)
 289         -- Double is dealt with separately in getGates
 290     default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
 291
 292         -- Add occurrences for IO or PrimIO
 293     implicit_main |  mod_name == mAIN_Name
 294                   || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
 295                   |  otherwise                  = []
 296
 297         -- Now add extra "occurrences" for things that
 298         -- the deriving mechanism, or defaulting, will later need in order to
 299         -- generate code
 300     implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
 301
 302         -- Virtually every program has error messages in it somewhere
 303     string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR,
 304                    unpackCStringUtf8_RDR, eqString_RDR]
 305
 306     get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _))
 307        = concat (map get_deriv deriv_classes)
 308     get other = []
 309
 310     get_deriv cls = case lookupUFM derivingOccurrences cls of
 311                         Nothing   -> []
 312                         Just occs -> occs
 313 \end{code}
 314
 315 \begin{code}
 316 isOrphanDecl this_mod (InstD (InstDecl inst_ty _ _ _ _))
 317   = not (foldNameSet ((||) . nameIsLocalOrFrom this_mod) False
 318                      (extractHsTyNames (removeContext inst_ty)))
 319         -- The 'removeContext' is because of
 320         --      instance Foo a => Baz T where ...
 321         -- The decl is an orphan if Baz and T are both not locally defined,
 322         --      even if Foo *is* locally defined
 323
 324 isOrphanDecl this_mod (RuleD (HsRule _ _ _ lhs _ _))
 325   = check lhs
 326   where
 327         -- At the moment we just check for common LHS forms
 328         -- Expand as necessary.  Getting it wrong just means
 329         -- more orphans than necessary
 330     check (HsVar v)       = not (nameIsLocalOrFrom this_mod v)
 331     check (HsApp f a)     = check f && check a
 332     check (HsLit _)       = False
 333     check (HsOverLit _)   = False
 334     check (OpApp l o _ r) = check l && check o && check r
 335     check (NegApp e _)    = check e
 336     check (HsPar e)       = check e
 337     check (SectionL e o)  = check e && check o
 338     check (SectionR o e)  = check e && check o
 339
 340     check other           = True        -- Safe fall through
 341
 342 isOrphanDecl _ _  = False
 343 \end{code}
 344
 345
 346 %*********************************************************
 347 %*                                                       *
 348 \subsection{Fixities}
 349 %*                                                       *
 350 %*********************************************************
 351
 352 \begin{code}
 353 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG LocalFixityEnv
 354 fixitiesFromLocalDecls gbl_env decls
 355   = foldlRn getFixities emptyNameEnv decls                              `thenRn` \ env ->
 356     traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))    `thenRn_`
 357     returnRn env
 358   where
 359     getFixities :: LocalFixityEnv -> RdrNameHsDecl -> RnMG LocalFixityEnv
 360     getFixities acc (FixD fix)
 361       = fix_decl acc fix
 362
 363     getFixities acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ ))
 364       = foldlRn fix_decl acc [sig | FixSig sig <- sigs]
 365                 -- Get fixities from class decl sigs too.
 366     getFixities acc other_decl
 367       = returnRn acc
 368
 369     fix_decl acc sig@(FixitySig rdr_name fixity loc)
 370         =       -- Check for fixity decl for something not declared
 371           pushSrcLocRn loc                      $
 372           lookupSrcName gbl_env rdr_name        `thenRn` \ name ->
 373
 374                 -- Check for duplicate fixity decl
 375           case lookupNameEnv acc name of
 376             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')     `thenRn_`
 377                                          returnRn acc ;
 378
 379             Nothing                   -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
 380 \end{code}
 381
 382
 383 %*********************************************************
 384 %*                                                       *
 385 \subsection{Deprecations}
 386 %*                                                       *
 387 %*********************************************************
 388
 389 For deprecations, all we do is check that the names are in scope.
 390 It's only imported deprecations, dealt with in RnIfaces, that we
 391 gather them together.
 392
 393 \begin{code}
 394 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
 395            -> [RdrNameDeprecation] -> RnMG Deprecations
 396 rnDeprecs gbl_env Nothing []
 397  = returnRn NoDeprecs
 398
 399 rnDeprecs gbl_env (Just txt) decls
 400  = mapRn (addErrRn . badDeprec) decls   `thenRn_`
 401    returnRn (DeprecAll txt)
 402
 403 rnDeprecs gbl_env Nothing decls
 404   = mapRn rn_deprec decls       `thenRn` \ pairs ->
 405     returnRn (DeprecSome (mkNameEnv (catMaybes pairs)))
 406  where
 407    rn_deprec (Deprecation rdr_name txt loc)
 408      = pushSrcLocRn loc                         $
 409        lookupSrcName gbl_env rdr_name           `thenRn` \ name ->
 410        returnRn (Just (name, (name,txt)))
 411 \end{code}
 412
 413
 414 %************************************************************************
 415 %*                                                                      *
 416 \subsection{Grabbing the old interface file and checking versions}
 417 %*                                                                      *
 418 %************************************************************************
 419
 420 \begin{code}
 421 checkOldIface :: DynFlags
 422               -> HomeIfaceTable -> HomeSymbolTable
 423               -> PersistentCompilerState
 424               -> FilePath
 425               -> Bool                   -- Source unchanged
 426               -> Maybe ModIface         -- Old interface from compilation manager, if any
 427               -> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
 428                                 -- True <=> errors happened
 429
 430 checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
 431   = runRn dflags hit hst pcs (panic "Bogus module") $
 432     case maybe_iface of
 433        Just old_iface -> -- Use the one we already have
 434                          setModuleRn (mi_module old_iface) (check_versions old_iface)
 435
 436        Nothing -- try and read it from a file
 437           -> readIface iface_path       `thenRn` \ read_result ->
 438              case read_result of
 439                Left err -> -- Old interface file not found, or garbled; give up
 440                            traceRn (text "Bad old interface file" $$ nest 4 err)        `thenRn_`
 441                            returnRn (outOfDate, Nothing)
 442
 443                Right parsed_iface
 444                       -> setModuleRn (pi_mod parsed_iface) $
 445                          loadOldIface parsed_iface `thenRn` \ m_iface ->
 446                          check_versions m_iface
 447     where
 448        check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
 449        check_versions iface
 450           = -- Check versions
 451             recompileRequired iface_path source_unchanged iface
 452                                                         `thenRn` \ recompile ->
 453             returnRn (recompile, Just iface)
 454 \end{code}
 455
 456 I think the following function should now have a more representative name,
 457 but what?
 458
 459 \begin{code}
 460 loadOldIface :: ParsedIface -> RnMG ModIface
 461
 462 loadOldIface parsed_iface
 463   = let iface = parsed_iface
 464         mod = pi_mod iface
 465     in
 466     initIfaceRnMS mod (
 467         loadHomeDecls (pi_decls iface)  `thenRn` \ decls ->
 468         loadHomeRules (pi_rules iface)  `thenRn` \ rules ->
 469         loadHomeInsts (pi_insts iface)  `thenRn` \ insts ->
 470         returnRn (decls, rules, insts)
 471     )
 472         `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
 473
 474     mapRn loadHomeUsage (pi_usages iface)       `thenRn` \ usages ->
 475     loadExports         (pi_exports iface)      `thenRn` \ (export_vers, avails) ->
 476     loadFixDecls mod    (pi_fixity iface)       `thenRn` \ fix_env ->
 477     loadDeprecs mod     (pi_deprecs iface)      `thenRn` \ deprec_env ->
 478     let
 479         version = VersionInfo { vers_module  = pi_vers iface,
 480                                 vers_exports = export_vers,
 481                                 vers_rules   = rule_vers,
 482                                 vers_decls   = decls_vers }
 483
 484         decls = mkIfaceDecls new_decls new_rules new_insts
 485
 486         mod_iface = ModIface { mi_module = mod, mi_version = version,
 487                                mi_exports = avails, mi_usages  = usages,
 488                                mi_boot = False, mi_orphan = pi_orphan iface,
 489                                mi_fixities = fix_env, mi_deprecs = deprec_env,
 490                                mi_decls   = decls,
 491                                mi_globals = panic "No mi_globals in old interface"
 492                     }
 493     in
 494     returnRn mod_iface
 495 \end{code}
 496
 497 \begin{code}
 498 loadHomeDecls :: [(Version, RdrNameTyClDecl)]
 499               -> RnMS (NameEnv Version, [RenamedTyClDecl])
 500 loadHomeDecls decls = foldlRn loadHomeDecl (emptyNameEnv, []) decls
 501
 502 loadHomeDecl :: (NameEnv Version, [RenamedTyClDecl])
 503              -> (Version, RdrNameTyClDecl)
 504              -> RnMS (NameEnv Version, [RenamedTyClDecl])
 505 loadHomeDecl (version_map, decls) (version, decl)
 506   = rnTyClDecl decl     `thenRn` \ decl' ->
 507     returnRn (extendNameEnv version_map (tyClDeclName decl') version, decl':decls)
 508
 509 ------------------
 510 loadHomeRules :: (Version, [RdrNameRuleDecl])
 511               -> RnMS (Version, [RenamedRuleDecl])
 512 loadHomeRules (version, rules)
 513   = mapRn rnIfaceRuleDecl rules `thenRn` \ rules' ->
 514     returnRn (version, rules')
 515
 516 ------------------
 517 loadHomeInsts :: [RdrNameInstDecl]
 518               -> RnMS [RenamedInstDecl]
 519 loadHomeInsts insts = mapRn rnInstDecl insts
 520
 521 ------------------
 522 loadHomeUsage :: ImportVersion OccName
 523               -> RnMG (ImportVersion Name)
 524 loadHomeUsage (mod_name, orphans, is_boot, whats_imported)
 525   = rn_imps whats_imported      `thenRn` \ whats_imported' ->
 526     returnRn (mod_name, orphans, is_boot, whats_imported')
 527   where
 528     rn_imps NothingAtAll                  = returnRn NothingAtAll
 529     rn_imps (Everything v)                = returnRn (Everything v)
 530     rn_imps (Specifically mv ev items rv) = mapRn rn_imp items  `thenRn` \ items' ->
 531                                             returnRn (Specifically mv ev items' rv)
 532     rn_imp (occ,vers) = newGlobalName mod_name occ      `thenRn` \ name ->
 533                         returnRn (name,vers)
 534 \end{code}
 535
 536
 537
 538 %*********************************************************
 539 %*                                                       *
 540 \subsection{Closing up the interface decls}
 541 %*                                                       *
 542 %*********************************************************
 543
 544 Suppose we discover we don't need to recompile.   Then we start from the
 545 IfaceDecls in the ModIface, and fluff them up by sucking in all the decls they need.
 546
 547 \begin{code}
 548 closeIfaceDecls :: DynFlags
 549                 -> HomeIfaceTable -> HomeSymbolTable
 550                 -> PersistentCompilerState
 551                 -> ModIface     -- Get the decls from here
 552                 -> IO (PersistentCompilerState, Bool, [RenamedHsDecl])
 553                                 -- True <=> errors happened
 554 closeIfaceDecls dflags hit hst pcs
 555                 mod_iface@(ModIface { mi_module = mod, mi_decls = iface_decls })
 556   = runRn dflags hit hst pcs mod $
 557
 558     let
 559         rule_decls = dcl_rules iface_decls
 560         inst_decls = dcl_insts iface_decls
 561         tycl_decls = dcl_tycl  iface_decls
 562         decls = map RuleD rule_decls ++
 563                 map InstD inst_decls ++
 564                 map TyClD tycl_decls
 565         needed = unionManyNameSets (map ruleDeclFVs rule_decls) `unionNameSets`
 566                  unionManyNameSets (map instDeclFVs inst_decls) `unionNameSets`
 567                  unionManyNameSets (map tyClDeclFVs tycl_decls)
 568     in
 569     closeDecls decls needed
 570 \end{code}
 571
 572 %*********************************************************
 573 %*                                                       *
 574 \subsection{Unused names}
 575 %*                                                       *
 576 %*********************************************************
 577
 578 \begin{code}
 579 reportUnusedNames :: ModIface -> PrintUnqualified
 580                   -> [RdrNameImportDecl]
 581                   -> AvailEnv
 582                   -> NameSet            -- Used in this module
 583                   -> Avails             -- Exported by this module
 584                   -> [RenamedHsDecl]
 585                   -> RnMG ()
 586 reportUnusedNames my_mod_iface unqual imports avail_env
 587                   source_fvs export_avails imported_decls
 588   = warnUnusedModules unused_imp_mods                           `thenRn_`
 589     warnUnusedLocalBinds bad_locals                             `thenRn_`
 590     warnUnusedImports bad_imp_names                             `thenRn_`
 591     printMinimalImports this_mod unqual minimal_imports         `thenRn_`
 592     warnDeprecations this_mod export_avails my_deprecs
 593                      really_used_names
 594
 595   where
 596     this_mod   = mi_module my_mod_iface
 597     gbl_env    = mi_globals my_mod_iface
 598     my_deprecs = mi_deprecs 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 :: [(Name,Provenance)]
 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 :: [(Name,Provenance)]
 632     (defined_and_used, defined_but_not_used) = partition used defined_names
 633     used (name,_)                            = name `elemNameSet` really_used_names
 634
 635     -- Filter out the ones only defined implicitly
 636     bad_locals :: [Name]
 637     bad_locals     = [n     | (n,LocalDef) <- defined_but_not_used]
 638
 639     bad_imp_names :: [(Name,Provenance)]
 640     bad_imp_names  = [(n,p) | (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     add_name (n,NonLocalDef (UserImport m _ _)) acc = addToFM_C plusAvailEnv acc (moduleName (nameModule n))
 674                                                                 (unitAvailEnv (mk_avail n))
 675     add_name (n,other_prov)                     acc = acc
 676
 677     mk_avail n = case lookupNameEnv avail_env n of
 678                 Just (AvailTC m _) | n==m      -> AvailTC n [n]
 679                                    | otherwise -> AvailTC m [n,m]
 680                 Just avail         -> Avail n
 681                 Nothing            -> pprPanic "mk_avail" (ppr n)
 682
 683     add_inst_mod m acc
 684       | m `elemFM` acc = acc    -- We import something already
 685       | otherwise      = addToFM acc m emptyAvailEnv
 686         -- Add an empty collection of imports for a module
 687         -- from which we have sucked only instance decls
 688
 689     direct_import_mods :: [ModuleName]
 690     direct_import_mods = nub [m | ImportDecl m _ _ _ _ _ <- imports]
 691
 692     -- unused_imp_mods are the directly-imported modules
 693     -- that are not mentioned in minimal_imports
 694     unused_imp_mods = [m | m <- direct_import_mods,
 695                        not (maybeToBool (lookupFM minimal_imports m)),
 696                        m /= pRELUDE_Name]
 697
 698     module_unused :: Module -> Bool
 699     module_unused mod = moduleName mod `elem` unused_imp_mods
 700
 701 warnDeprecations this_mod export_avails my_deprecs used_names
 702   = doptRn Opt_WarnDeprecations                         `thenRn` \ warn_drs ->
 703     if not warn_drs then returnRn () else
 704
 705         -- The home modules for things in the export list
 706         -- may not have been loaded yet; do it now, so
 707         -- that we can see their deprecations, if any
 708     mapRn_ load_home export_mods                `thenRn_`
 709
 710     getIfacesRn                                 `thenRn` \ ifaces ->
 711     getHomeIfaceTableRn                         `thenRn` \ hit ->
 712     let
 713         pit     = iPIT ifaces
 714         deprecs = [ (n,txt)
 715                   | n <- nameSetToList used_names,
 716                     Just txt <- [lookup_deprec hit pit n] ]
 717     in
 718     mapRn_ warnDeprec deprecs
 719
 720   where
 721     export_mods = nub [ moduleName (nameModule name)
 722                       | avail <- export_avails,
 723                         let name = availName avail,
 724                         not (nameIsLocalOrFrom this_mod name) ]
 725
 726     load_home m = loadInterface (text "Check deprecations for" <+> ppr m) m ImportBySystem
 727
 728     lookup_deprec hit pit n
 729         | nameIsLocalOrFrom this_mod n
 730         = lookupDeprec my_deprecs n
 731         | otherwise
 732         = case lookupIface hit pit n of
 733                 Just iface -> lookupDeprec (mi_deprecs iface) n
 734                 Nothing    -> pprPanic "warnDeprecations:" (ppr n)
 735
 736 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
 737 printMinimalImports this_mod unqual imps
 738   = doptRn Opt_D_dump_minimal_imports           `thenRn` \ dump_minimal ->
 739     if not dump_minimal then returnRn () else
 740
 741     mapRn to_ies (fmToList imps)                `thenRn` \ mod_ies ->
 742     ioToRnM (do { h <- openFile filename WriteMode ;
 743                   printForUser h unqual (vcat (map ppr_mod_ie mod_ies))
 744         })                                      `thenRn_`
 745     returnRn ()
 746   where
 747     filename = moduleNameUserString (moduleName this_mod) ++ ".imports"
 748     ppr_mod_ie (mod_name, ies)
 749         | mod_name == pRELUDE_Name
 750         = empty
 751         | otherwise
 752         = ptext SLIT("import") <+> ppr mod_name <>
 753                             parens (fsep (punctuate comma (map ppr ies)))
 754
 755     to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)      `thenRn` \ ies ->
 756                               returnRn (mod, ies)
 757
 758     to_ie :: AvailInfo -> RnMG (IE Name)
 759     to_ie (Avail n)       = returnRn (IEVar n)
 760     to_ie (AvailTC n [m]) = ASSERT( n==m )
 761                             returnRn (IEThingAbs n)
 762     to_ie (AvailTC n ns)
 763         = getInterfaceExports n_mod ImportBySystem              `thenRn` \ (_, avails_by_module) ->
 764           case [xs | (m,as) <- avails_by_module,
 765                      m == n_mod,
 766                      AvailTC x xs <- as,
 767                      x == n] of
 768               [xs] | all (`elem` ns) xs -> returnRn (IEThingAll n)
 769                    | otherwise          -> returnRn (IEThingWith n (filter (/= n) ns))
 770               other                     -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
 771                                            returnRn (IEVar n)
 772         where
 773           n_mod = moduleName (nameModule n)
 774
 775 rnDump  :: [RenamedHsDecl]      -- Renamed imported decls
 776         -> [RenamedHsDecl]      -- Renamed local decls
 777         -> RnMG ()
 778 rnDump imp_decls local_decls
 779   = doptRn Opt_D_dump_rn_trace  `thenRn` \ dump_rn_trace ->
 780     doptRn Opt_D_dump_rn_stats  `thenRn` \ dump_rn_stats ->
 781     doptRn Opt_D_dump_rn        `thenRn` \ dump_rn ->
 782     getIfacesRn                 `thenRn` \ ifaces ->
 783
 784     ioToRnM (do { dumpIfSet (dump_rn_trace || dump_rn_stats || dump_rn)
 785                             "Renamer statistics"
 786                             (getRnStats imp_decls ifaces) ;
 787
 788                   dumpIfSet dump_rn "Renamer:"
 789                             (vcat (map ppr (local_decls ++ imp_decls)))
 790     })                          `thenRn_`
 791
 792     returnRn ()
 793 \end{code}
 794
 795
 796 %*********************************************************
 797 %*                                                      *
 798 \subsection{Statistics}
 799 %*                                                      *
 800 %*********************************************************
 801
 802 \begin{code}
 803 getRnStats :: [RenamedHsDecl] -> Ifaces -> SDoc
 804 getRnStats imported_decls ifaces
 805   = hcat [text "Renamer stats: ", stats]
 806   where
 807     n_mods = length [() | _ <- moduleEnvElts (iPIT ifaces)]
 808         -- This is really only right for a one-shot compile
 809
 810     (decls_map, n_decls_slurped) = iDecls ifaces
 811
 812     n_decls_left   = length [decl | (avail, True, (_,decl)) <- nameEnvElts decls_map
 813                         -- Data, newtype, and class decls are in the decls_fm
 814                         -- under multiple names; the tycon/class, and each
 815                         -- constructor/class op too.
 816                         -- The 'True' selects just the 'main' decl
 817                      ]
 818
 819     (insts_left, n_insts_slurped) = iInsts ifaces
 820     n_insts_left  = length (bagToList insts_left)
 821
 822     (rules_left, n_rules_slurped) = iRules ifaces
 823     n_rules_left  = length (bagToList rules_left)
 824
 825     stats = vcat
 826         [int n_mods <+> text "interfaces read",
 827          hsep [ int n_decls_slurped, text "type/class/variable imported, out of",
 828                 int (n_decls_slurped + n_decls_left), text "read"],
 829          hsep [ int n_insts_slurped, text "instance decls imported, out of",
 830                 int (n_insts_slurped + n_insts_left), text "read"],
 831          hsep [ int n_rules_slurped, text "rule decls imported, out of",
 832                 int (n_rules_slurped + n_rules_left), text "read"]
 833         ]
 834 \end{code}
 835
 836
 837 %************************************************************************
 838 %*                                                                      *
 839 \subsection{Errors and warnings}
 840 %*                                                                      *
 841 %************************************************************************
 842
 843 \begin{code}
 844 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
 845 warnDeprec (name, txt)
 846   = pushSrcLocRn (getSrcLoc name)       $
 847     addWarnRn                           $
 848     sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
 849           text "is deprecated:", nest 4 (ppr txt) ]
 850
 851
 852 dupFixityDecl rdr_name loc1 loc2
 853   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 854           ptext SLIT("at ") <+> ppr loc1,
 855           ptext SLIT("and") <+> ppr loc2]
 856
 857 badDeprec d
 858   = sep [ptext SLIT("Illegal deprecation when whole module is deprecated"),
 859          nest 4 (ppr d)]
 860
 861 noMainErr
 862   = hsep [ptext SLIT("Module"), quotes (ppr mAIN_Name),
 863           ptext SLIT("must include a definition for"), quotes (ptext SLIT("main"))]
 864 \end{code}
 865
 866