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