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 ) where
   8
   9 #include "HsVersions.h"
  10
  11 import HsSyn
  12 import HsPragmas        ( DataPragmas(..) )
  13 import RdrHsSyn         ( RdrNameHsModule, RdrNameHsDecl, RdrNameDeprecation )
  14 import RnHsSyn          ( RenamedHsModule, RenamedHsDecl,
  15                           extractHsTyNames, extractHsCtxtTyNames
  16                         )
  17
  18 import CmdLineOpts      ( DynFlags, DynFlag(..) )
  19 import RnMonad
  20 import RnNames          ( getGlobalNames )
  21 import RnSource         ( rnSourceDecls, rnDecl )
  22 import RnIfaces         ( getImportedInstDecls, importDecl, mkImportExportInfo,
  23                           getInterfaceExports,
  24                           getImportedRules, getSlurped, removeContext,
  25                           loadBuiltinRules, getDeferredDecls, ImportDeclResult(..)
  26                         )
  27 import RnEnv            ( availName, availsToNameSet,
  28                           emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv,
  29                           warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
  30                           lookupOrigNames, unknownNameErr,
  31                           FreeVars, plusFVs, plusFV, unitFV, emptyFVs, isEmptyFVs, addOneFV
  32                         )
  33 import Module           ( Module, ModuleName, WhereFrom(..),
  34                           moduleNameUserString, moduleName, mkModuleInThisPackage
  35                         )
  36 import Name             ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
  37                           nameOccName, nameUnique, nameModule,
  38 --                        maybeUserImportedFrom,
  39 --                        isUserImportedExplicitlyName, isUserImportedName,
  40 --                        maybeWiredInTyConName, maybeWiredInIdName,
  41                           isUserExportedName, toRdrName,
  42                           nameEnvElts, extendNameEnv
  43                         )
  44 import OccName          ( occNameFlavour, isValOcc )
  45 import Id               ( idType )
  46 import TyCon            ( isSynTyCon, getSynTyConDefn )
  47 import NameSet
  48 import TysWiredIn       ( unitTyCon, intTyCon, doubleTyCon, boolTyCon )
  49 import PrelRules        ( builtinRules )
  50 import PrelNames        ( mAIN_Name, pREL_MAIN_Name, pRELUDE_Name,
  51                           ioTyCon_RDR,
  52                           unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
  53                           eqString_RDR
  54                         )
  55 import PrelInfo         ( fractionalClassKeys, derivingOccurrences,
  56                           maybeWiredInTyConName, maybeWiredInIdName )
  57 import Type             ( namesOfType, funTyCon )
  58 import ErrUtils         ( printErrorsAndWarnings, dumpIfSet, ghcExit )
  59 import BasicTypes       ( Version, initialVersion )
  60 import Bag              ( isEmptyBag, bagToList )
  61 import FiniteMap        ( FiniteMap, eltsFM, fmToList, emptyFM, lookupFM,
  62                           addToFM_C, elemFM, addToFM
  63                         )
  64 import UniqSupply       ( UniqSupply )
  65 import UniqFM           ( lookupUFM )
  66 import SrcLoc           ( noSrcLoc )
  67 import Maybes           ( maybeToBool, expectJust )
  68 import Outputable
  69 import IO               ( openFile, IOMode(..) )
  70 import HscTypes         ( Finder, PersistentCompilerState, HomeSymbolTable, GlobalRdrEnv,
  71                           AvailEnv, Avails, GenAvailInfo(..), AvailInfo,
  72                           Provenance(..), ImportReason(..) )
  73
  74 -- HACKS:
  75 maybeUserImportedFrom        = panic "maybeUserImportedFrom"
  76 isUserImportedExplicitlyName = panic "isUserImportedExplicitlyName"
  77 isUserImportedName           = panic "isUserImportedName"
  78 iDeprecs                     = panic "iDeprecs"
  79 type FixityEnv = LocalFixityEnv
  80 \end{code}
  81
  82
  83
  84 \begin{code}
  85 type RenameResult = ( PersistentCompilerState
  86                     , ModIface
  87                     )
  88
  89 renameModule :: DynFlags -> Finder
  90              -> PersistentCompilerState -> HomeSymbolTable
  91              -> RdrNameHsModule
  92              -> IO (PersistentCompilerState, Maybe ModIface)
  93                         -- The mi_decls in the ModIface include
  94                         -- ones imported from packages too
  95
  96 renameModule dflags finder old_pcs hst
  97              this_mod@(HsModule mod_name vers exports imports local_decls _ loc)
  98   =     -- Initialise the renamer monad
  99     do {
 100         ((maybe_rn_stuff, dump_action), (rn_warns_bag, rn_errs_bag), new_pcs)
 101            <- initRn dflags finder old_pcs hst loc (rename this_mod) ;
 102
 103         -- Check for warnings
 104         printErrorsAndWarnings (rn_warns_bag, rn_errs_bag) ;
 105
 106         -- Dump any debugging output
 107         dump_action ;
 108
 109         -- Return results
 110         if not (isEmptyBag rn_errs_bag) then
 111             return (old_pcs, Nothing)
 112         else
 113             return (new_pcs, maybe_rn_stuff)
 114     }
 115 \end{code}
 116
 117 \begin{code}
 118 rename :: RdrNameHsModule -> RnMG (Maybe ModIface, IO ())
 119 rename this_mod@(HsModule mod_name vers exports imports local_decls mod_deprec loc)
 120   =     -- FIND THE GLOBAL NAME ENVIRONMENT
 121     getGlobalNames this_mod                     `thenRn` \ maybe_stuff ->
 122
 123         -- CHECK FOR EARLY EXIT
 124     case maybe_stuff of {
 125         Nothing ->      -- Everything is up to date; no need to recompile further
 126                 rnDump [] []            `thenRn` \ dump_action ->
 127                 returnRn (Nothing, dump_action) ;
 128
 129         Just (gbl_env, local_gbl_env, export_avails, global_avail_env, old_iface) ->
 130
 131         -- DEAL WITH DEPRECATIONS
 132     rnDeprecs local_gbl_env mod_deprec local_decls      `thenRn` \ my_deprecs ->
 133
 134         -- DEAL WITH LOCAL FIXITIES
 135     fixitiesFromLocalDecls local_gbl_env local_decls    `thenRn` \ local_fixity_env ->
 136
 137         -- RENAME THE SOURCE
 138     initRnMS gbl_env local_fixity_env SourceMode (
 139         rnSourceDecls local_decls
 140     )                                   `thenRn` \ (rn_local_decls, source_fvs) ->
 141
 142         -- SLURP IN ALL THE NEEDED DECLARATIONS
 143     implicitFVs mod_name rn_local_decls         `thenRn` \ implicit_fvs ->
 144     let
 145                 -- The export_fvs make the exported names look just as if they
 146                 -- occurred in the source program.  For the reasoning, see the
 147                 -- comments with RnIfaces.getImportVersions.
 148                 -- We only need the 'parent name' of the avail;
 149                 -- that's enough to suck in the declaration.
 150         export_fvs      = mkNameSet (map availName export_avails)
 151         real_source_fvs = source_fvs `plusFV` export_fvs
 152
 153         slurp_fvs       = implicit_fvs `plusFV` real_source_fvs
 154                 -- It's important to do the "plus" this way round, so that
 155                 -- when compiling the prelude, locally-defined (), Bool, etc
 156                 -- override the implicit ones.
 157     in
 158     loadBuiltinRules builtinRules       `thenRn_`
 159     slurpImpDecls slurp_fvs             `thenRn` \ rn_imp_decls ->
 160
 161         -- EXIT IF ERRORS FOUND
 162     rnDump rn_imp_decls rn_local_decls          `thenRn` \ dump_action ->
 163     checkErrsRn                                 `thenRn` \ no_errs_so_far ->
 164     if not no_errs_so_far then
 165         -- Found errors already, so exit now
 166         returnRn (Nothing, dump_action)
 167     else
 168
 169         -- GENERATE THE VERSION/USAGE INFO
 170     mkImportExportInfo mod_name export_avails imports   `thenRn` \ (my_exports, my_usages) ->
 171
 172         -- RETURN THE RENAMED MODULE
 173     getNameSupplyRn                     `thenRn` \ name_supply ->
 174     getIfacesRn                         `thenRn` \ ifaces ->
 175     let
 176         direct_import_mods :: [Module]
 177         direct_import_mods = [m | (_, _, Just (m, _, _, _, imp, _))
 178                                   <- eltsFM (iImpModInfo ifaces), user_import imp]
 179
 180                 -- *don't* just pick the forward edges.  It's entirely possible
 181                 -- that a module is only reachable via back edges.
 182         user_import ImportByUser = True
 183         user_import ImportByUserSource = True
 184         user_import _ = False
 185
 186         this_module        = mkModuleInThisPackage mod_name
 187
 188         -- Export only those fixities that are for names that are
 189         --      (a) defined in this module
 190         --      (b) exported
 191         exported_fixities
 192           = mkNameEnv [ (name, fixity)
 193                       | FixitySig name fixity loc <- nameEnvElts local_fixity_env,
 194                         isUserExportedName name
 195                       ]
 196
 197         mod_iface = ModIface {  mi_module  = this_module
 198                                 mi_version = panic "mi_version: not filled in yet",
 199                                 mi_orphan  = any isOrphanDecl rn_local_decls,
 200                                 mi_exports = my_exports,
 201                                 mi_usages  = my_usages,
 202                                 mi_fixity  = exported_fixities)
 203                                 mi_deprecs = my_deprecs
 204                                 mi_decls   = rn_local_decls ++ rn_imp_decls
 205                     }
 206     in
 207
 208         -- REPORT UNUSED NAMES, AND DEBUG DUMP
 209     reportUnusedNames mod_name direct_import_mods
 210                       gbl_env global_avail_env
 211                       export_avails source_fvs
 212                       rn_imp_decls                      `thenRn_`
 213
 214     returnRn (Just mod_iface, dump_action) }
 215   where
 216     trashed_exports  = {-trace "rnSource:trashed_exports"-} Nothing
 217     trashed_imports  = {-trace "rnSource:trashed_imports"-} []
 218 \end{code}
 219
 220 @implicitFVs@ forces the renamer to slurp in some things which aren't
 221 mentioned explicitly, but which might be needed by the type checker.
 222
 223 \begin{code}
 224 implicitFVs mod_name decls
 225   = lookupOrigNames implicit_occs                       `thenRn` \ implicit_names ->
 226     returnRn (mkNameSet (map getName default_tycons)    `plusFV`
 227               implicit_names)
 228   where
 229         -- Add occurrences for Int, and (), because they
 230         -- are the types to which ambigious type variables may be defaulted by
 231         -- the type checker; so they won't always appear explicitly.
 232         -- [The () one is a GHC extension for defaulting CCall results.]
 233         -- ALSO: funTyCon, since it occurs implicitly everywhere!
 234         --       (we don't want to be bothered with making funTyCon a
 235         --        free var at every function application!)
 236         -- Double is dealt with separately in getGates
 237     default_tycons = [unitTyCon, funTyCon, boolTyCon, intTyCon]
 238
 239         -- Add occurrences for IO or PrimIO
 240     implicit_main |  mod_name == mAIN_Name
 241                   || mod_name == pREL_MAIN_Name = [ioTyCon_RDR]
 242                   |  otherwise                  = []
 243
 244         -- Now add extra "occurrences" for things that
 245         -- the deriving mechanism, or defaulting, will later need in order to
 246         -- generate code
 247     implicit_occs = string_occs ++ foldr ((++) . get) implicit_main decls
 248
 249         -- Virtually every program has error messages in it somewhere
 250     string_occs = [unpackCString_RDR, unpackCStringFoldr_RDR, unpackCStringUtf8_RDR,
 251                    eqString_RDR]
 252
 253     get (TyClD (TyData _ _ _ _ _ _ (Just deriv_classes) _ _ _ _))
 254        = concat (map get_deriv deriv_classes)
 255     get other = []
 256
 257     get_deriv cls = case lookupUFM derivingOccurrences cls of
 258                         Nothing   -> []
 259                         Just occs -> occs
 260 \end{code}
 261
 262 \begin{code}
 263 isOrphanDecl (InstD (InstDecl inst_ty _ _ _ _))
 264   = not (foldNameSet ((||) . isLocallyDefined) False (extractHsTyNames (removeContext inst_ty)))
 265         -- The 'removeContext' is because of
 266         --      instance Foo a => Baz T where ...
 267         -- The decl is an orphan if Baz and T are both not locally defined,
 268         --      even if Foo *is* locally defined
 269
 270 isOrphanDecl (RuleD (HsRule _ _ _ lhs _ _))
 271   = check lhs
 272   where
 273         -- At the moment we just check for common LHS forms
 274         -- Expand as necessary.  Getting it wrong just means
 275         -- more orphans than necessary
 276     check (HsVar v)       = not (isLocallyDefined v)
 277     check (HsApp f a)     = check f && check a
 278     check (HsLit _)       = False
 279     check (HsOverLit _)   = False
 280     check (OpApp l o _ r) = check l && check o && check r
 281     check (NegApp e _)    = check e
 282     check (HsPar e)       = check e
 283     check (SectionL e o)  = check e && check o
 284     check (SectionR o e)  = check e && check o
 285
 286     check other           = True        -- Safe fall through
 287
 288 isOrphanDecl other = False
 289 \end{code}
 290
 291
 292 \begin{code}
 293 dupDefaultDeclErrRn (DefaultDecl _ locn1 : dup_things)
 294   = pushSrcLocRn locn1  $
 295     addErrRn msg
 296   where
 297     msg = hang (ptext SLIT("Multiple default declarations"))
 298                4  (vcat (map pp dup_things))
 299     pp (DefaultDecl _ locn) = ptext SLIT("here was another default declaration") <+> ppr locn
 300 \end{code}
 301
 302
 303 %*********************************************************
 304 %*                                                       *
 305 \subsection{Slurping declarations}
 306 %*                                                       *
 307 %*********************************************************
 308
 309 \begin{code}
 310 -------------------------------------------------------
 311 slurpImpDecls source_fvs
 312   = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
 313
 314         -- The current slurped-set records all local things
 315     getSlurped                                  `thenRn` \ source_binders ->
 316     slurpSourceRefs source_binders source_fvs   `thenRn` \ (decls, needed) ->
 317
 318         -- Then get everything else
 319     closeDecls decls needed                     `thenRn` \ decls1 ->
 320
 321         -- Finally, get any deferred data type decls
 322     slurpDeferredDecls decls1                   `thenRn` \ final_decls ->
 323
 324     returnRn final_decls
 325
 326 -------------------------------------------------------
 327 slurpSourceRefs :: NameSet                      -- Variables defined in source
 328                 -> FreeVars                     -- Variables referenced in source
 329                 -> RnMG ([RenamedHsDecl],
 330                          FreeVars)              -- Un-satisfied needs
 331 -- The declaration (and hence home module) of each gate has
 332 -- already been loaded
 333
 334 slurpSourceRefs source_binders source_fvs
 335   = go_outer []                         -- Accumulating decls
 336              emptyFVs                   -- Unsatisfied needs
 337              emptyFVs                   -- Accumulating gates
 338              (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
 339   where
 340         -- The outer loop repeatedly slurps the decls for the current gates
 341         -- and the instance decls
 342
 343         -- The outer loop is needed because consider
 344         --      instance Foo a => Baz (Maybe a) where ...
 345         -- It may be that @Baz@ and @Maybe@ are used in the source module,
 346         -- but not @Foo@; so we need to chase @Foo@ too.
 347         --
 348         -- We also need to follow superclass refs.  In particular, 'chasing @Foo@' must
 349         -- include actually getting in Foo's class decl
 350         --      class Wib a => Foo a where ..
 351         -- so that its superclasses are discovered.  The point is that Wib is a gate too.
 352         -- We do this for tycons too, so that we look through type synonyms.
 353
 354     go_outer decls fvs all_gates []
 355         = returnRn (decls, fvs)
 356
 357     go_outer decls fvs all_gates refs   -- refs are not necessarily slurped yet
 358         = traceRn (text "go_outer" <+> ppr refs)                `thenRn_`
 359           foldlRn go_inner (decls, fvs, emptyFVs) refs          `thenRn` \ (decls1, fvs1, gates1) ->
 360           getImportedInstDecls (all_gates `plusFV` gates1)      `thenRn` \ inst_decls ->
 361           rnInstDecls decls1 fvs1 gates1 inst_decls             `thenRn` \ (decls2, fvs2, gates2) ->
 362           go_outer decls2 fvs2 (all_gates `plusFV` gates2)
 363                                (nameSetToList (gates2 `minusNameSet` all_gates))
 364                 -- Knock out the all_gates because even if we don't slurp any new
 365                 -- decls we can get some apparently-new gates from wired-in names
 366
 367     go_inner (decls, fvs, gates) wanted_name
 368         = importDecl wanted_name                `thenRn` \ import_result ->
 369           case import_result of
 370             AlreadySlurped -> returnRn (decls, fvs, gates)
 371             WiredIn        -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
 372             Deferred       -> returnRn (decls, fvs, gates `addOneFV` wanted_name)       -- It's a type constructor
 373
 374             HereItIs decl -> rnIfaceDecl decl           `thenRn` \ (new_decl, fvs1) ->
 375                              returnRn (new_decl : decls,
 376                                        fvs1 `plusFV` fvs,
 377                                        gates `plusFV` getGates source_fvs new_decl)
 378
 379 rnInstDecls decls fvs gates []
 380   = returnRn (decls, fvs, gates)
 381 rnInstDecls decls fvs gates (d:ds)
 382   = rnIfaceDecl d               `thenRn` \ (new_decl, fvs1) ->
 383     rnInstDecls (new_decl:decls)
 384                 (fvs1 `plusFV` fvs)
 385                 (gates `plusFV` getInstDeclGates new_decl)
 386                 ds
 387 \end{code}
 388
 389
 390 \begin{code}
 391 -------------------------------------------------------
 392 -- closeDecls keeps going until the free-var set is empty
 393 closeDecls decls needed
 394   | not (isEmptyFVs needed)
 395   = slurpDecls decls needed     `thenRn` \ (decls1, needed1) ->
 396     closeDecls decls1 needed1
 397
 398   | otherwise
 399   = getImportedRules                    `thenRn` \ rule_decls ->
 400     case rule_decls of
 401         []    -> returnRn decls -- No new rules, so we are done
 402         other -> rnIfaceDecls decls emptyFVs rule_decls         `thenRn` \ (decls1, needed1) ->
 403                  closeDecls decls1 needed1
 404
 405
 406 -------------------------------------------------------
 407 -- Augment decls with any decls needed by needed.
 408 -- Return also free vars of the new decls (only)
 409 slurpDecls decls needed
 410   = go decls emptyFVs (nameSetToList needed)
 411   where
 412     go decls fvs []         = returnRn (decls, fvs)
 413     go decls fvs (ref:refs) = slurpDecl decls fvs ref   `thenRn` \ (decls1, fvs1) ->
 414                               go decls1 fvs1 refs
 415
 416 -------------------------------------------------------
 417 slurpDecl decls fvs wanted_name
 418   = importDecl wanted_name              `thenRn` \ import_result ->
 419     case import_result of
 420         -- Found a declaration... rename it
 421         HereItIs decl -> rnIfaceDecl decl               `thenRn` \ (new_decl, fvs1) ->
 422                          returnRn (new_decl:decls, fvs1 `plusFV` fvs)
 423
 424         -- No declaration... (wired in thing, or deferred, or already slurped)
 425         other -> returnRn (decls, fvs)
 426
 427
 428 -------------------------------------------------------
 429 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
 430              -> [(Module, RdrNameHsDecl)]
 431              -> RnM d ([RenamedHsDecl], FreeVars)
 432 rnIfaceDecls decls fvs []     = returnRn (decls, fvs)
 433 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d           `thenRn` \ (new_decl, fvs1) ->
 434                                 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
 435
 436 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
 437 \end{code}
 438
 439
 440 %*********************************************************
 441 %*                                                       *
 442 \subsection{Deferred declarations}
 443 %*                                                       *
 444 %*********************************************************
 445
 446 The idea of deferred declarations is this.  Suppose we have a function
 447         f :: T -> Int
 448         data T = T1 A | T2 B
 449         data A = A1 X | A2 Y
 450         data B = B1 P | B2 Q
 451 Then we don't want to load T and all its constructors, and all
 452 the types those constructors refer to, and all the types *those*
 453 constructors refer to, and so on.  That might mean loading many more
 454 interface files than is really necessary.  So we 'defer' loading T.
 455
 456 But f might be strict, and the calling convention for evaluating
 457 values of type T depends on how many constructors T has, so
 458 we do need to load T, but not the full details of the type T.
 459 So we load the full decl for T, but only skeleton decls for A and B:
 460         f :: T -> Int
 461         data T = {- 2 constructors -}
 462
 463 Whether all this is worth it is moot.
 464
 465 \begin{code}
 466 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
 467 slurpDeferredDecls decls
 468   = getDeferredDecls                                            `thenRn` \ def_decls ->
 469     rnIfaceDecls decls emptyFVs (map stripDecl def_decls)       `thenRn` \ (decls1, fvs) ->
 470     ASSERT( isEmptyFVs fvs )
 471     returnRn decls1
 472
 473 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ _ loc name1 name2))
 474   = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing NoDataPragmas loc
 475                 name1 name2))
 476         -- Nuke the context and constructors
 477         -- But retain the *number* of constructors!
 478         -- Also the tvs will have kinds on them.
 479 \end{code}
 480
 481
 482 %*********************************************************
 483 %*                                                       *
 484 \subsection{Extracting the `gates'}
 485 %*                                                       *
 486 %*********************************************************
 487
 488 When we import a declaration like
 489 \begin{verbatim}
 490         data T = T1 Wibble | T2 Wobble
 491 \end{verbatim}
 492 we don't want to treat @Wibble@ and @Wobble@ as gates
 493 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
 494 If only @T@ is mentioned
 495 we want only @T@ to be a gate;
 496 that way we don't suck in useless instance
 497 decls for (say) @Eq Wibble@, when they can't possibly be useful.
 498
 499 @getGates@ takes a newly imported (and renamed) decl, and the free
 500 vars of the source program, and extracts from the decl the gate names.
 501
 502 \begin{code}
 503 getGates source_fvs (SigD (IfaceSig _ ty _ _))
 504   = extractHsTyNames ty
 505
 506 getGates source_fvs (TyClD (ClassDecl ctxt cls tvs _ sigs _ _ _ _ ))
 507   = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
 508                         (hsTyVarNames tvs)
 509      `addOneToNameSet` cls)
 510     `plusFV` maybe_double
 511   where
 512     get (ClassOpSig n _ ty _)
 513         | n `elemNameSet` source_fvs = extractHsTyNames ty
 514         | otherwise                  = emptyFVs
 515
 516         -- If we load any numeric class that doesn't have
 517         -- Int as an instance, add Double to the gates.
 518         -- This takes account of the fact that Double might be needed for
 519         -- defaulting, but we don't want to load Double (and all its baggage)
 520         -- if the more exotic classes aren't used at all.
 521     maybe_double | nameUnique cls `elem` fractionalClassKeys
 522                  = unitFV (getName doubleTyCon)
 523                  | otherwise
 524                  = emptyFVs
 525
 526 getGates source_fvs (TyClD (TySynonym tycon tvs ty _))
 527   = delListFromNameSet (extractHsTyNames ty)
 528                        (hsTyVarNames tvs)
 529         -- A type synonym type constructor isn't a "gate" for instance decls
 530
 531 getGates source_fvs (TyClD (TyData _ ctxt tycon tvs cons _ _ _ _ _ _))
 532   = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
 533                        (hsTyVarNames tvs)
 534     `addOneToNameSet` tycon
 535   where
 536     get (ConDecl n _ tvs ctxt details _)
 537         | n `elemNameSet` source_fvs
 538                 -- If the constructor is method, get fvs from all its fields
 539         = delListFromNameSet (get_details details `plusFV`
 540                               extractHsCtxtTyNames ctxt)
 541                              (hsTyVarNames tvs)
 542     get (ConDecl n _ tvs ctxt (RecCon fields) _)
 543                 -- Even if the constructor isn't mentioned, the fields
 544                 -- might be, as selectors.  They can't mention existentially
 545                 -- bound tyvars (typechecker checks for that) so no need for
 546                 -- the deleteListFromNameSet part
 547         = foldr (plusFV . get_field) emptyFVs fields
 548
 549     get other_con = emptyFVs
 550
 551     get_details (VanillaCon tys) = plusFVs (map get_bang tys)
 552     get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
 553     get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
 554
 555     get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
 556                      | otherwise                         = emptyFVs
 557
 558     get_bang bty = extractHsTyNames (getBangType bty)
 559
 560 getGates source_fvs other_decl = emptyFVs
 561 \end{code}
 562
 563 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
 564 rather than a declaration.
 565
 566 \begin{code}
 567 getWiredInGates :: Name -> FreeVars
 568 getWiredInGates name    -- No classes are wired in
 569   | is_id                = getWiredInGates_s (namesOfType (idType the_id))
 570   | isSynTyCon the_tycon = getWiredInGates_s
 571          (delListFromNameSet (namesOfType ty) (map getName tyvars))
 572   | otherwise            = unitFV name
 573   where
 574     maybe_wired_in_id    = maybeWiredInIdName name
 575     is_id                = maybeToBool maybe_wired_in_id
 576     maybe_wired_in_tycon = maybeWiredInTyConName name
 577     Just the_id          = maybe_wired_in_id
 578     Just the_tycon       = maybe_wired_in_tycon
 579     (tyvars,ty)          = getSynTyConDefn the_tycon
 580
 581 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
 582 \end{code}
 583
 584 \begin{code}
 585 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
 586 getInstDeclGates other                              = emptyFVs
 587 \end{code}
 588
 589
 590 %*********************************************************
 591 %*                                                       *
 592 \subsection{Fixities}
 593 %*                                                       *
 594 %*********************************************************
 595
 596 \begin{code}
 597 fixitiesFromLocalDecls :: GlobalRdrEnv -> [RdrNameHsDecl] -> RnMG FixityEnv
 598 fixitiesFromLocalDecls gbl_env decls
 599   = doptRn Opt_WarnUnusedBinds                            `thenRn` \ warn_unused ->
 600     foldlRn (getFixities warn_unused) emptyNameEnv decls  `thenRn` \ env ->
 601     traceRn (text "fixity env" <+> vcat (map ppr (nameEnvElts env)))
 602                                                           `thenRn_`
 603     returnRn env
 604   where
 605     getFixities :: Bool -> FixityEnv -> RdrNameHsDecl -> RnMG FixityEnv
 606     getFixities warn_uu acc (FixD fix)
 607       = fix_decl warn_uu acc fix
 608
 609     getFixities warn_uu acc (TyClD (ClassDecl _ _ _ _ sigs _ _ _ _ ))
 610       = foldlRn (fix_decl warn_uu) acc [sig | FixSig sig <- sigs]
 611                 -- Get fixities from class decl sigs too.
 612     getFixities warn_uu acc other_decl
 613       = returnRn acc
 614
 615     fix_decl warn_uu acc sig@(FixitySig rdr_name fixity loc)
 616         =       -- Check for fixity decl for something not declared
 617           case lookupRdrEnv gbl_env rdr_name of {
 618             Nothing | warn_uu
 619                     -> pushSrcLocRn loc (addWarnRn (unusedFixityDecl rdr_name fixity))
 620                        `thenRn_` returnRn acc
 621                     | otherwise -> returnRn acc ;
 622
 623             Just ((name,_):_) ->
 624
 625                 -- Check for duplicate fixity decl
 626           case lookupNameEnv acc name of {
 627             Just (FixitySig _ _ loc') -> addErrRn (dupFixityDecl rdr_name loc loc')
 628                                          `thenRn_` returnRn acc ;
 629
 630             Nothing -> returnRn (extendNameEnv acc name (FixitySig name fixity loc))
 631           }}
 632 \end{code}
 633
 634
 635 %*********************************************************
 636 %*                                                       *
 637 \subsection{Deprecations}
 638 %*                                                       *
 639 %*********************************************************
 640
 641 For deprecations, all we do is check that the names are in scope.
 642 It's only imported deprecations, dealt with in RnIfaces, that we
 643 gather them together.
 644
 645 \begin{code}
 646 rnDeprecs :: GlobalRdrEnv -> Maybe DeprecTxt
 647            -> [RdrNameHsDecl] -> RnMG [RdrNameDeprecation]
 648 rnDeprecs gbl_env mod_deprec decls
 649  = mapRn rn_deprec deprecs      `thenRn_`
 650    returnRn (extra_deprec ++ deprecs)
 651  where
 652    deprecs = [d | DeprecD d <- decls]
 653    extra_deprec = case mod_deprec of
 654                    Nothing  -> []
 655                    Just txt -> [Deprecation (IEModuleContents undefined) txt noSrcLoc]
 656
 657    rn_deprec (Deprecation ie txt loc)
 658      = pushSrcLocRn loc         $
 659        mapRn check (ieNames ie)
 660
 661    check n = case lookupRdrEnv gbl_env n of
 662                 Nothing -> addErrRn (unknownNameErr n)
 663                 Just _  -> returnRn ()
 664 \end{code}
 665
 666
 667 %*********************************************************
 668 %*                                                       *
 669 \subsection{Unused names}
 670 %*                                                       *
 671 %*********************************************************
 672
 673 \begin{code}
 674 reportUnusedNames :: ModuleName -> [Module]
 675                   -> GlobalRdrEnv -> AvailEnv
 676                   -> Avails -> NameSet -> [RenamedHsDecl]
 677                   -> RnMG ()
 678 reportUnusedNames mod_name direct_import_mods
 679                   gbl_env avail_env
 680                   export_avails mentioned_names
 681                   imported_decls
 682   = let
 683         used_names = mentioned_names `unionNameSets` availsToNameSet export_avails
 684
 685         -- Now, a use of C implies a use of T,
 686         -- if C was brought into scope by T(..) or T(C)
 687         really_used_names = used_names `unionNameSets`
 688           mkNameSet [ availName parent_avail
 689                     | sub_name <- nameSetToList used_names
 690                     , isValOcc (getOccName sub_name)
 691
 692                         -- Usually, every used name will appear in avail_env, but there
 693                         -- is one time when it doesn't: tuples and other built in syntax.  When you
 694                         -- write (a,b) that gives rise to a *use* of "(,)", so that the
 695                         -- instances will get pulled in, but the tycon "(,)" isn't actually
 696                         -- in scope.  Hence the isValOcc filter.
 697                         --
 698                         -- Also, (-x) gives rise to an implicit use of 'negate'; similarly,
 699                         --   3.5 gives rise to an implcit use of :%
 700                         -- hence the isUserImportedName filter on the warning
 701
 702                     , let parent_avail
 703                             = case lookupNameEnv avail_env sub_name of
 704                                 Just avail -> avail
 705                                 Nothing -> WARN( isUserImportedName sub_name,
 706                                                  text "reportUnusedName: not in avail_env" <+>
 707                                                         ppr sub_name )
 708                                            Avail sub_name
 709
 710                     , case parent_avail of { AvailTC _ _ -> True; other -> False }
 711                     ]
 712
 713         defined_names, defined_but_not_used :: [(Name,Provenance)]
 714         defined_names        = concat (rdrEnvElts gbl_env)
 715         defined_but_not_used = filter not_used defined_names
 716         not_used name        = not (name `elemNameSet` really_used_names)
 717
 718         -- Filter out the ones only defined implicitly
 719         bad_locals :: [Name]
 720         bad_locals     = [n     | (n,LocalDef) <- defined_but_not_used]
 721
 722         bad_imp_names :: [(Name,Provenance)]
 723         bad_imp_names  = [(n,p) | (n,p@(UserImport mod _ True)) <- defined_but_not_used,
 724                                   not (module_unused mod)]
 725
 726         deprec_used deprec_env = [ (n,txt)
 727                                  | n <- nameSetToList mentioned_names,
 728                                    not (isLocallyDefined n),
 729                                    Just txt <- [lookupNameEnv deprec_env n] ]
 730
 731         -- inst_mods are directly-imported modules that
 732         --      contain instance decl(s) that the renamer decided to suck in
 733         -- It's not necessarily redundant to import such modules.
 734         --
 735         -- NOTE: Consider
 736         --            module This
 737         --              import M ()
 738         --
 739         --       The import M() is not *necessarily* redundant, even if
 740         --       we suck in no instance decls from M (e.g. it contains
 741         --       no instance decls, or This contains no code).  It may be
 742         --       that we import M solely to ensure that M's orphan instance
 743         --       decls (or those in its imports) are visible to people who
 744         --       import This.  Sigh.
 745         --       There's really no good way to detect this, so the error message
 746         --       in RnEnv.warnUnusedModules is weakened instead
 747         inst_mods = [m | InstD (InstDecl _ _ _ (Just dfun) _) <- imported_decls,
 748                          let m = nameModule dfun,
 749                          m `elem` direct_import_mods
 750                     ]
 751
 752         minimal_imports :: FiniteMap Module AvailEnv
 753         minimal_imports0 = emptyFM
 754         minimal_imports1 = foldNameSet add_name minimal_imports0 really_used_names
 755         minimal_imports  = foldr   add_inst_mod minimal_imports1 inst_mods
 756
 757         add_name n acc = case maybeUserImportedFrom n of
 758                            Nothing -> acc
 759                            Just m  -> addToFM_C plusAvailEnv acc m
 760                                                 (unitAvailEnv (mk_avail n))
 761         add_inst_mod m acc
 762           | m `elemFM` acc = acc        -- We import something already
 763           | otherwise      = addToFM acc m emptyAvailEnv
 764                 -- Add an empty collection of imports for a module
 765                 -- from which we have sucked only instance decls
 766
 767         mk_avail n = case lookupNameEnv avail_env n of
 768                         Just (AvailTC m _) | n==m      -> AvailTC n [n]
 769                                            | otherwise -> AvailTC m [n,m]
 770                         Just avail         -> Avail n
 771                         Nothing            -> pprPanic "mk_avail" (ppr n)
 772
 773         -- unused_imp_mods are the directly-imported modules
 774         -- that are not mentioned in minimal_imports
 775         unused_imp_mods = [m | m <- direct_import_mods,
 776                                not (maybeToBool (lookupFM minimal_imports m)),
 777                                moduleName m /= pRELUDE_Name]
 778
 779         module_unused :: Module -> Bool
 780         module_unused mod = mod `elem` unused_imp_mods
 781
 782     in
 783     warnUnusedModules unused_imp_mods                           `thenRn_`
 784     warnUnusedLocalBinds bad_locals                             `thenRn_`
 785     warnUnusedImports bad_imp_names                             `thenRn_`
 786     printMinimalImports mod_name minimal_imports                `thenRn_`
 787     getIfacesRn                                                 `thenRn` \ ifaces ->
 788     doptRn Opt_WarnDeprecations                                 `thenRn` \ warn_drs ->
 789     (if warn_drs
 790         then mapRn_ warnDeprec (deprec_used (iDeprecs ifaces))
 791         else returnRn ())
 792
 793 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
 794 printMinimalImports mod_name imps
 795   = doptRn Opt_D_dump_minimal_imports           `thenRn` \ dump_minimal ->
 796     printMinimalImports_wrk dump_minimal mod_name imps
 797
 798 printMinimalImports_wrk dump_minimal mod_name imps
 799   | not dump_minimal
 800   = returnRn ()
 801   | otherwise
 802   = mapRn to_ies (fmToList imps)                `thenRn` \ mod_ies ->
 803     ioToRnM (do { h <- openFile filename WriteMode ;
 804                   printForUser h (vcat (map ppr_mod_ie mod_ies))
 805         })                                      `thenRn_`
 806     returnRn ()
 807   where
 808     filename = moduleNameUserString mod_name ++ ".imports"
 809     ppr_mod_ie (mod_name, ies)
 810         | mod_name == pRELUDE_Name
 811         = empty
 812         | otherwise
 813         = ptext SLIT("import") <+> ppr mod_name <>
 814                             parens (fsep (punctuate comma (map ppr ies)))
 815
 816     to_ies (mod, avail_env) = mapRn to_ie (availEnvElts avail_env)      `thenRn` \ ies ->
 817                               returnRn (moduleName mod, ies)
 818
 819     to_ie :: AvailInfo -> RnMG (IE Name)
 820     to_ie (Avail n)       = returnRn (IEVar n)
 821     to_ie (AvailTC n [m]) = ASSERT( n==m )
 822                             returnRn (IEThingAbs n)
 823     to_ie (AvailTC n ns)  = getInterfaceExports (moduleName (nameModule n))
 824                                                 ImportBySystem          `thenRn` \ (_, avails) ->
 825                             case [ms | AvailTC m ms <- avails, m == n] of
 826                               [ms] | all (`elem` ns) ms -> returnRn (IEThingAll n)
 827                                    | otherwise          -> returnRn (IEThingWith n (filter (/= n) ns))
 828                               other -> pprTrace "to_ie" (ppr n <+> ppr (nameModule n) <+> ppr other) $
 829                                        returnRn (IEVar n)
 830
 831 rnDump  :: [RenamedHsDecl]      -- Renamed imported decls
 832         -> [RenamedHsDecl]      -- Renamed local decls
 833         -> RnMG (IO ())
 834 rnDump imp_decls local_decls
 835    = doptRn Opt_D_dump_rn_trace         `thenRn` \ dump_rn_trace ->
 836      doptRn Opt_D_dump_rn_stats         `thenRn` \ dump_rn_stats ->
 837      doptRn Opt_D_dump_rn               `thenRn` \ dump_rn ->
 838      if dump_rn_trace || dump_rn_stats || dump_rn then
 839         getRnStats imp_decls            `thenRn` \ stats_msg ->
 840         returnRn (printErrs stats_msg >>
 841                   dumpIfSet dump_rn "Renamer:"
 842                             (vcat (map ppr (local_decls ++ imp_decls))))
 843      else
 844         returnRn (return ())
 845 \end{code}
 846
 847
 848 %*********************************************************
 849 %*                                                      *
 850 \subsection{Statistics}
 851 %*                                                      *
 852 %*********************************************************
 853
 854 \begin{code}
 855 getRnStats :: [RenamedHsDecl] -> RnMG SDoc
 856 getRnStats imported_decls
 857   = getIfacesRn                 `thenRn` \ ifaces ->
 858     let
 859         n_mods = length [() | (_, _, Just _) <- eltsFM (iImpModInfo ifaces)]
 860
 861         decls_read     = [decl | (_, avail, True, (_,decl)) <- nameEnvElts (iDecls ifaces),
 862                                 -- Data, newtype, and class decls are in the decls_fm
 863                                 -- under multiple names; the tycon/class, and each
 864                                 -- constructor/class op too.
 865                                 -- The 'True' selects just the 'main' decl
 866                                  not (isLocallyDefined (availName avail))
 867                              ]
 868
 869         (cd_rd, dd_rd, nd_rd, sd_rd, vd_rd,     _) = count_decls decls_read
 870         (cd_sp, dd_sp, nd_sp, sd_sp, vd_sp, id_sp) = count_decls imported_decls
 871
 872         unslurped_insts       = iInsts ifaces
 873         inst_decls_unslurped  = length (bagToList unslurped_insts)
 874         inst_decls_read       = id_sp + inst_decls_unslurped
 875
 876         stats = vcat
 877                 [int n_mods <+> text "interfaces read",
 878                  hsep [ int cd_sp, text "class decls imported, out of",
 879                         int cd_rd, text "read"],
 880                  hsep [ int dd_sp, text "data decls imported, out of",
 881                         int dd_rd, text "read"],
 882                  hsep [ int nd_sp, text "newtype decls imported, out of",
 883                         int nd_rd, text "read"],
 884                  hsep [int sd_sp, text "type synonym decls imported, out of",
 885                         int sd_rd, text "read"],
 886                  hsep [int vd_sp, text "value signatures imported, out of",
 887                         int vd_rd, text "read"],
 888                  hsep [int id_sp, text "instance decls imported, out of",
 889                         int inst_decls_read, text "read"],
 890                  text "cls dcls slurp" <+> fsep (map (ppr . tyClDeclName)
 891                                            [d | TyClD d <- imported_decls, isClassDecl d]),
 892                  text "cls dcls read"  <+> fsep (map (ppr . tyClDeclName)
 893                                            [d | TyClD d <- decls_read, isClassDecl d])]
 894     in
 895     returnRn (hcat [text "Renamer stats: ", stats])
 896
 897 count_decls decls
 898   = (class_decls,
 899      data_decls,
 900      newtype_decls,
 901      syn_decls,
 902      val_decls,
 903      inst_decls)
 904   where
 905     tycl_decls = [d | TyClD d <- decls]
 906     (class_decls, data_decls, newtype_decls, syn_decls) = countTyClDecls tycl_decls
 907
 908     val_decls     = length [() | SigD _   <- decls]
 909     inst_decls    = length [() | InstD _  <- decls]
 910 \end{code}
 911
 912
 913 %************************************************************************
 914 %*                                                                      *
 915 \subsection{Errors and warnings}
 916 %*                                                                      *
 917 %************************************************************************
 918
 919 \begin{code}
 920 warnDeprec :: (Name, DeprecTxt) -> RnM d ()
 921 warnDeprec (name, txt)
 922   = pushSrcLocRn (getSrcLoc name)       $
 923     addWarnRn                           $
 924     sep [ text (occNameFlavour (nameOccName name)) <+> ppr name <+>
 925           text "is deprecated:", nest 4 (ppr txt) ]
 926
 927
 928 unusedFixityDecl rdr_name fixity
 929   = hsep [ptext SLIT("Unused fixity declaration for"), quotes (ppr rdr_name)]
 930
 931 dupFixityDecl rdr_name loc1 loc2
 932   = vcat [ptext SLIT("Multiple fixity declarations for") <+> quotes (ppr rdr_name),
 933           ptext SLIT("at ") <+> ppr loc1,
 934           ptext SLIT("and") <+> ppr loc2]
 935 \end{code}
 936
 937
 938 \begin{code}
 939 checkEarlyExit mod_name
 940   = traceRn (text "Considering whether compilation is required...")     `thenRn_`
 941
 942         -- Read the old interface file, if any, for the module being compiled
 943     findAndReadIface doc_str mod_name False {- Not hi-boot -}   `thenRn` \ maybe_iface ->
 944
 945         -- CHECK WHETHER WE HAVE IT ALREADY
 946     case maybe_iface of
 947         Left err ->     -- Old interface file not found, so we'd better bail out
 948                     traceRn (vcat [ptext SLIT("No old interface file for") <+> ppr mod_name,
 949                                    err])                        `thenRn_`
 950                     returnRn (outOfDate, Nothing)
 951
 952         Right iface
 953           | panic "checkEarlyExit: ???: not opt_SourceUnchanged"
 954           ->    -- Source code changed
 955              traceRn (nest 4 (text "source file changed or recompilation check turned off"))    `thenRn_`
 956              returnRn (False, Just iface)
 957
 958           | otherwise
 959           ->    -- Source code unchanged and no errors yet... carry on
 960              checkModUsage (pi_usages iface)    `thenRn` \ up_to_date ->
 961              returnRn (up_to_date, Just iface)
 962   where
 963         -- Only look in current directory, with suffix .hi
 964     doc_str = sep [ptext SLIT("need usage info from"), ppr mod_name]
 965 \end{code}
 966
 967 %********************************************************
 968 %*                                                      *
 969 \subsection{Checking usage information}
 970 %*                                                      *
 971 %********************************************************
 972
 973 \begin{code}
 974 upToDate  = True
 975 outOfDate = False
 976
 977 checkModUsage :: [ImportVersion OccName] -> RnMG Bool
 978 -- Given the usage information extracted from the old
 979 -- M.hi file for the module being compiled, figure out
 980 -- whether M needs to be recompiled.
 981
 982 checkModUsage [] = returnRn upToDate            -- Yes!  Everything is up to date!
 983
 984 checkModUsage ((mod_name, _, _, NothingAtAll) : rest)
 985         -- If CurrentModule.hi contains
 986         --      import Foo :: ;
 987         -- then that simply records that Foo lies below CurrentModule in the
 988         -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
 989         -- In this case we don't even want to open Foo's interface.
 990   = traceRn (ptext SLIT("Nothing used from:") <+> ppr mod_name) `thenRn_`
 991     checkModUsage rest  -- This one's ok, so check the rest
 992
 993 checkModUsage ((mod_name, _, _, whats_imported)  : rest)
 994   = tryLoadInterface doc_str mod_name ImportBySystem    `thenRn` \ (ifaces, maybe_err) ->
 995     case maybe_err of {
 996         Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
 997                                       ppr mod_name]) ;
 998                 -- Couldn't find or parse a module mentioned in the
 999                 -- old interface file.  Don't complain -- it might just be that
1000                 -- the current module doesn't need that import and it's been deleted
1001
1002         Nothing ->
1003     let
1004         (_, new_mod_vers, new_fix_vers, new_rule_vers, _, _)
1005                 = case lookupFM (iImpModInfo ifaces) mod_name of
1006                            Just (_, _, Just stuff) -> stuff
1007
1008         old_mod_vers = case whats_imported of
1009                          Everything v        -> v
1010                          Specifically v _ _ _ -> v
1011                          -- NothingAtAll case dealt with by previous eqn for checkModUsage
1012     in
1013         -- If the module version hasn't changed, just move on
1014     if new_mod_vers == old_mod_vers then
1015         traceRn (sep [ptext SLIT("Module version unchanged:"), ppr mod_name])
1016         `thenRn_` checkModUsage rest
1017     else
1018     traceRn (sep [ptext SLIT("Module version has changed:"), ppr mod_name])
1019     `thenRn_`
1020         -- Module version changed, so check entities inside
1021
1022         -- If the usage info wants to say "I imported everything from this module"
1023         --     it does so by making whats_imported equal to Everything
1024         -- In that case, we must recompile
1025     case whats_imported of {    -- NothingAtAll dealt with earlier
1026
1027       Everything _
1028         -> out_of_date (ptext SLIT("...and I needed the whole module")) ;
1029
1030       Specifically _ old_fix_vers old_rule_vers old_local_vers ->
1031
1032     if old_fix_vers /= new_fix_vers then
1033         out_of_date (ptext SLIT("Fixities changed"))
1034     else if old_rule_vers /= new_rule_vers then
1035         out_of_date (ptext SLIT("Rules changed"))
1036     else
1037         -- Non-empty usage list, so check item by item
1038     checkEntityUsage mod_name (iDecls ifaces) old_local_vers    `thenRn` \ up_to_date ->
1039     if up_to_date then
1040         traceRn (ptext SLIT("...but the bits I use haven't."))  `thenRn_`
1041         checkModUsage rest      -- This one's ok, so check the rest
1042     else
1043         returnRn outOfDate      -- This one failed, so just bail out now
1044     }}
1045   where
1046     doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
1047
1048
1049 checkEntityUsage mod decls []
1050   = returnRn upToDate   -- Yes!  All up to date!
1051
1052 checkEntityUsage mod decls ((occ_name,old_vers) : rest)
1053   = newGlobalName mod occ_name  `thenRn` \ name ->
1054     case lookupNameEnv decls name of
1055
1056         Nothing       ->        -- We used it before, but it ain't there now
1057                           out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
1058
1059         Just (new_vers,_,_,_)   -- It's there, but is it up to date?
1060                 | new_vers == old_vers
1061                         -- Up to date, so check the rest
1062                 -> checkEntityUsage mod decls rest
1063
1064                 | otherwise
1065                         -- Out of date, so bale out
1066                 -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
1067
1068 out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate
1069 \end{code}
1070
1071