ghc/compiler/rename/RnIfaces.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
   5
   6 \begin{code}
   7 module RnIfaces
   8      (
   9         recordLocalSlurps,
  10         mkImportInfo,
  11
  12         slurpImpDecls, closeDecls,
  13
  14         RecompileRequired, outOfDate, upToDate, recompileRequired
  15        )
  16 where
  17
  18 #include "HsVersions.h"
  19
  20 import CmdLineOpts      ( opt_IgnoreIfacePragmas, opt_NoPruneDecls )
  21 import HscTypes
  22 import HsSyn            ( HsDecl(..), Sig(..), TyClDecl(..), ConDecl(..), ConDetails(..),
  23                           InstDecl(..), HsType(..), hsTyVarNames, getBangType
  24                         )
  25 import HsImpExp         ( ImportDecl(..) )
  26 import RdrHsSyn         ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
  27 import RnHsSyn          ( RenamedHsDecl, RenamedTyClDecl,
  28                           extractHsTyNames, extractHsCtxtTyNames,
  29                           tyClDeclFVs, ruleDeclFVs, instDeclFVs
  30                         )
  31 import RnHiFiles        ( tryLoadInterface, loadHomeInterface,
  32                           loadOrphanModules
  33                         )
  34 import RnSource         ( rnTyClDecl, rnInstDecl, rnIfaceRuleDecl )
  35 import RnEnv
  36 import RnMonad
  37 import Id               ( idType, idName, globalIdDetails )
  38 import IdInfo           ( GlobalIdDetails(..) )
  39 import TcType           ( namesOfType )
  40 import FieldLabel       ( fieldLabelTyCon )
  41 import DataCon          ( dataConTyCon )
  42 import TyCon            ( visibleDataCons, isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
  43 import Class            ( className )
  44 import Name             ( Name {-instance NamedThing-}, nameOccName,
  45                           nameModule, isInternalName, NamedThing(..)
  46                          )
  47 import NameEnv          ( elemNameEnv, delFromNameEnv, lookupNameEnv )
  48 import NameSet
  49 import Module           ( Module, ModuleEnv,
  50                           moduleName, isHomeModule,
  51                           ModuleName, WhereFrom(..),
  52                           emptyModuleEnv,
  53                           extendModuleEnv_C, foldModuleEnv, lookupModuleEnv,
  54                           elemModuleSet, extendModuleSet
  55                         )
  56 import PrelInfo         ( wiredInThingEnv, hasKey, fractionalClassKey, numClassKey,
  57                           integerTyConName, doubleTyConName )
  58 import Maybe            ( isJust )
  59 import FiniteMap
  60 import Outputable
  61 import Bag
  62 import Util             ( sortLt )
  63 \end{code}
  64
  65
  66 %*********************************************************
  67 %*                                                      *
  68 \subsection{Keeping track of what we've slurped, and version numbers}
  69 %*                                                      *
  70 %*********************************************************
  71
  72 mkImportInfo figures out what the ``usage information'' for this
  73 moudule is; that is, what it must record in its interface file as the
  74 things it uses.
  75
  76 We produce a line for every module B below the module, A, currently being
  77 compiled:
  78         import B <n> ;
  79 to record the fact that A does import B indirectly.  This is used to decide
  80 to look to look for B.hi rather than B.hi-boot when compiling a module that
  81 imports A.  This line says that A imports B, but uses nothing in it.
  82 So we'll get an early bale-out when compiling A if B's version changes.
  83
  84 The usage information records:
  85
  86 \begin{itemize}
  87 \item   (a) anything reachable from its body code
  88 \item   (b) any module exported with a @module Foo@
  89 \item   (c) anything reachable from an exported item
  90 \end{itemize}
  91
  92 Why (b)?  Because if @Foo@ changes then this module's export list
  93 will change, so we must recompile this module at least as far as
  94 making a new interface file --- but in practice that means complete
  95 recompilation.
  96
  97 Why (c)?  Consider this:
  98 \begin{verbatim}
  99         module A( f, g ) where  |       module B( f ) where
 100           import B( f )         |         f = h 3
 101           g = ...               |         h = ...
 102 \end{verbatim}
 103
 104 Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
 105 @A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
 106 *identical* to what it was before.  If anything about @B.f@ changes
 107 than anyone who imports @A@ should be recompiled in case they use
 108 @B.f@ (they'll get an early exit if they don't).  So, if anything
 109 about @B.f@ changes we'd better make sure that something in A.hi
 110 changes, and the convenient way to do that is to record the version
 111 number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
 112 complete recompiation of A, which is overkill but it's the only way to
 113 write a new, slightly different, A.hi.
 114
 115 But the example is tricker.  Even if @B.f@ doesn't change at all,
 116 @B.h@ may do so, and this change may not be reflected in @f@'s version
 117 number.  But with -O, a module that imports A must be recompiled if
 118 @B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
 119 the occurrence of @B.f@ in the export list *just as if* it were in the
 120 code of A, and thereby haul in all the stuff reachable from it.
 121
 122         *** Conclusion: if A mentions B.f in its export list,
 123             behave just as if A mentioned B.f in its source code,
 124             and slurp in B.f and all its transitive closure ***
 125
 126 [NB: If B was compiled with -O, but A isn't, we should really *still*
 127 haul in all the unfoldings for B, in case the module that imports A *is*
 128 compiled with -O.  I think this is the case.]
 129
 130 \begin{code}
 131 mkImportInfo :: ModuleName                      -- Name of this module
 132              -> [ImportDecl n]                  -- The import decls
 133              -> RnMG [ImportVersion Name]
 134
 135 mkImportInfo this_mod imports
 136   = getIfacesRn                                 `thenRn` \ ifaces ->
 137     getHomeIfaceTableRn                         `thenRn` \ hit ->
 138     let
 139         (imp_pkg_mods, imp_home_names) = iVSlurp ifaces
 140         pit                            = iPIT    ifaces
 141
 142         import_all_mods :: [ModuleName]
 143                 -- Modules where we imported all the names
 144                 -- (apart from hiding some, perhaps)
 145         import_all_mods = [ m | ImportDecl m _ _ _ imp_list _ <- imports,
 146                                 import_all imp_list ]
 147           where
 148            import_all (Just (False, _)) = False -- Imports are spec'd explicitly
 149            import_all other             = True  -- Everything is imported
 150
 151         -- mv_map groups together all the things imported and used
 152         -- from a particular module in this package
 153         -- We use a finite map because we want the domain
 154         mv_map :: ModuleEnv [Name]
 155         mv_map  = foldNameSet add_mv emptyModuleEnv imp_home_names
 156         add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
 157                            where
 158                              mod = nameModule name
 159                              add_item names _ = name:names
 160
 161         -- In our usage list we record
 162         --
 163         --      a) Specifically: Detailed version info for imports
 164         --         from modules in this package Gotten from iVSlurp plus
 165         --         import_all_mods
 166         --
 167         --      b) Everything: Just the module version for imports
 168         --         from modules in other packages Gotten from iVSlurp plus
 169         --         import_all_mods
 170         --
 171         --      c) NothingAtAll: The name only of modules, Baz, in
 172         --         this package that are 'below' us, but which we didn't need
 173         --         at all (this is needed only to decide whether to open Baz.hi
 174         --         or Baz.hi-boot higher up the tree).  This happens when a
 175         --         module, Foo, that we explicitly imported has 'import Baz' in
 176         --         its interface file, recording that Baz is below Foo in the
 177         --         module dependency hierarchy.  We want to propagate this
 178         --         info.  These modules are in a combination of HIT/PIT and
 179         --         iImpModInfo
 180         --
 181         --      d) NothingAtAll: The name only of all orphan modules
 182         --         we know of (this is needed so that anyone who imports us can
 183         --         find the orphan modules) These modules are in a combination
 184         --         of HIT/PIT and iImpModInfo
 185
 186         import_info0 = foldModuleEnv mk_imp_info  []           pit
 187         import_info1 = foldModuleEnv mk_imp_info  import_info0 hit
 188         import_info  = not_even_opened_imports ++ import_info1
 189
 190                 -- Recall that iImpModInfo describes modules that have
 191                 -- been mentioned in the import lists of interfaces we
 192                 -- have opened, but which we have not even opened when
 193                 -- compiling this module
 194         not_even_opened_imports =
 195           [ (mod_name, orphans, is_boot, NothingAtAll)
 196           | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ]
 197
 198
 199         mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
 200         mk_imp_info iface so_far
 201
 202           | Just ns <- lookupModuleEnv mv_map mod       -- Case (a)
 203           = go_for_it (Specifically mod_vers maybe_export_vers
 204                                     (mk_import_items ns) rules_vers)
 205
 206           | mod `elemModuleSet` imp_pkg_mods            -- Case (b)
 207           = go_for_it (Everything mod_vers)
 208
 209           | import_all_mod                              -- Case (a) and (b); the import-all part
 210           = if is_home_pkg_mod then
 211                 go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
 212                 -- Since the module isn't in the mv_map, presumably we
 213                 -- didn't actually import anything at all from it
 214             else
 215                 go_for_it (Everything mod_vers)
 216
 217           | is_home_pkg_mod || has_orphans              -- Case (c) or (d)
 218           = go_for_it NothingAtAll
 219
 220           | otherwise = so_far
 221           where
 222             go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
 223
 224             mod             = mi_module iface
 225             mod_name        = moduleName mod
 226             is_home_pkg_mod = isHomeModule mod
 227             version_info    = mi_version iface
 228             version_env     = vers_decls   version_info
 229             mod_vers        = vers_module  version_info
 230             rules_vers      = vers_rules   version_info
 231             export_vers     = vers_exports version_info
 232             import_all_mod  = mod_name `elem` import_all_mods
 233             has_orphans     = mi_orphan iface
 234
 235                 -- The sort is to put them into canonical order
 236             mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
 237                                           let v = lookupVersion version_env n
 238                                  ]
 239                          where
 240                            lt_occ n1 n2 = nameOccName n1 < nameOccName n2
 241
 242             maybe_export_vers | import_all_mod = Just (vers_exports version_info)
 243                               | otherwise      = Nothing
 244     in
 245     returnRn import_info
 246 \end{code}
 247
 248 %*********************************************************
 249 %*                                                       *
 250 \subsection{Slurping declarations}
 251 %*                                                       *
 252 %*********************************************************
 253
 254 \begin{code}
 255 -------------------------------------------------------
 256 slurpImpDecls source_fvs
 257   = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
 258
 259         -- The current slurped-set records all local things
 260     slurpSourceRefs source_fvs  `thenRn` \ (decls, needed) ->
 261
 262         -- Then get everything else
 263     closeDecls decls needed
 264
 265
 266 -------------------------------------------------------
 267 slurpSourceRefs :: FreeVars                     -- Variables referenced in source
 268                 -> RnMG ([RenamedHsDecl],
 269                          FreeVars)              -- Un-satisfied needs
 270 -- The declaration (and hence home module) of each gate has
 271 -- already been loaded
 272
 273 slurpSourceRefs source_fvs
 274   = go_outer []                         -- Accumulating decls
 275              emptyFVs                   -- Unsatisfied needs
 276              emptyFVs                   -- Accumulating gates
 277              (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
 278   where
 279         -- The outer loop repeatedly slurps the decls for the current gates
 280         -- and the instance decls
 281
 282         -- The outer loop is needed because consider
 283         --      instance Foo a => Baz (Maybe a) where ...
 284         -- It may be that Baz and Maybe are used in the source module,
 285         -- but not Foo; so we need to chase Foo too.
 286         --
 287         -- We also need to follow superclass refs.  In particular, 'chasing Foo' must
 288         -- include actually getting in Foo's class decl
 289         --      class Wib a => Foo a where ..
 290         -- so that its superclasses are discovered.  The point is that Wib is a gate too.
 291         -- We do this for tycons too, so that we look through type synonyms.
 292
 293     go_outer decls fvs all_gates []
 294         = returnRn (decls, fvs)
 295
 296     go_outer decls fvs all_gates refs   -- refs are not necessarily slurped yet
 297         = traceRn (text "go_outer" <+> ppr refs)                `thenRn_`
 298           foldlRn go_inner (decls, fvs, emptyFVs) refs          `thenRn` \ (decls1, fvs1, gates1) ->
 299           getImportedInstDecls (all_gates `plusFV` gates1)      `thenRn` \ inst_decls ->
 300           rnIfaceInstDecls decls1 fvs1 gates1 inst_decls        `thenRn` \ (decls2, fvs2, gates2) ->
 301           go_outer decls2 fvs2 (all_gates `plusFV` gates2)
 302                                (nameSetToList (gates2 `minusNameSet` all_gates))
 303                 -- Knock out the all_gates because even if we don't slurp any new
 304                 -- decls we can get some apparently-new gates from wired-in names
 305                 -- and we get an infinite loop
 306
 307     go_inner (decls, fvs, gates) wanted_name
 308         = importDecl wanted_name                `thenRn` \ import_result ->
 309           case import_result of
 310             AlreadySlurped     -> returnRn (decls, fvs, gates)
 311             InTypeEnv ty_thing -> returnRn (decls, fvs, gates `plusFV` getWiredInGates ty_thing)
 312
 313             HereItIs decl -> rnIfaceTyClDecl decl               `thenRn` \ (new_decl, fvs1) ->
 314                              returnRn (TyClD new_decl : decls,
 315                                        fvs1 `plusFV` fvs,
 316                                        gates `plusFV` getGates source_fvs new_decl)
 317 \end{code}
 318
 319
 320 \begin{code}
 321 -------------------------------------------------------
 322 -- closeDecls keeps going until the free-var set is empty
 323 closeDecls decls needed
 324   | not (isEmptyFVs needed)
 325   = slurpDecls decls needed     `thenRn` \ (decls1, needed1) ->
 326     closeDecls decls1 needed1
 327
 328   | otherwise
 329   = getImportedRules                    `thenRn` \ rule_decls ->
 330     case rule_decls of
 331         []    -> returnRn decls -- No new rules, so we are done
 332         other -> rnIfaceDecls rnIfaceRuleDecl rule_decls        `thenRn` \ rule_decls' ->
 333                  let
 334                         rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
 335                  in
 336                  traceRn (text "closeRules" <+> ppr rule_decls' $$ fsep (map ppr (nameSetToList rule_fvs)))     `thenRn_`
 337                  closeDecls (map RuleD rule_decls' ++ decls) rule_fvs
 338
 339
 340
 341 -------------------------------------------------------
 342 -- Augment decls with any decls needed by needed.
 343 -- Return also free vars of the new decls (only)
 344 slurpDecls decls needed
 345   = go decls emptyFVs (nameSetToList needed)
 346   where
 347     go decls fvs []         = returnRn (decls, fvs)
 348     go decls fvs (ref:refs) = slurpDecl decls fvs ref   `thenRn` \ (decls1, fvs1) ->
 349                               go decls1 fvs1 refs
 350
 351 -------------------------------------------------------
 352 slurpDecl decls fvs wanted_name
 353   = importDecl wanted_name              `thenRn` \ import_result ->
 354     case import_result of
 355         -- Found a declaration... rename it
 356         HereItIs decl -> rnIfaceTyClDecl decl           `thenRn` \ (new_decl, fvs1) ->
 357                          returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
 358
 359         -- No declaration... (wired in thing, or deferred, or already slurped)
 360         other -> returnRn (decls, fvs)
 361
 362
 363 -------------------------------------------------------
 364 rnIfaceDecls rn decls      = mapRn (rnIfaceDecl rn) decls
 365 rnIfaceDecl rn (mod, decl) = initIfaceRnMS mod (rn decl)
 366
 367 rnIfaceInstDecls decls fvs gates inst_decls
 368   = rnIfaceDecls rnInstDecl inst_decls  `thenRn` \ inst_decls' ->
 369     returnRn (map InstD inst_decls' ++ decls,
 370               fvs `plusFV` plusFVs (map instDeclFVs inst_decls'),
 371               gates `plusFV` plusFVs (map getInstDeclGates inst_decls'))
 372
 373 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl)       `thenRn` \ decl' ->
 374                               returnRn (decl', tyClDeclFVs decl')
 375 \end{code}
 376
 377
 378 \begin{code}
 379 recordDeclSlurp ifaces@(Ifaces { iDecls  = (decls_map, n_slurped),
 380                                  iSlurp  = slurped_names,
 381                                  iVSlurp = vslurp })
 382             avail
 383   = ASSERT2( not (isInternalName (availName avail)), ppr avail )
 384     ifaces { iDecls = (new_decls_map, n_slurped+1),
 385              iSlurp  = new_slurped_names,
 386              iVSlurp = updateVSlurp vslurp (availName avail) }
 387   where
 388     new_decls_map     = foldl delFromNameEnv decls_map (availNames avail)
 389     new_slurped_names = addAvailToNameSet slurped_names avail
 390
 391
 392 -- recordTypeEnvSlurp is used when we slurp something that's
 393 -- already in the type environment, that was not slurped in an earlier compilation.
 394 -- We record it in the iVSlurp set, because that's used to
 395 -- generate usage information
 396
 397 recordTypeEnvSlurp ifaces ty_thing
 398   = ifaces { iVSlurp = updateVSlurp (iVSlurp ifaces) (get_main_name ty_thing) }
 399   where
 400         -- Tiresomely, we must get the "main" name for the
 401         -- thing, because that's what VSlurp contains, and what
 402         -- is recorded in the usage information
 403     get_main_name (AClass cl) = className cl
 404     get_main_name (ATyCon tc)
 405         | Just clas <- tyConClass_maybe tc = get_main_name (AClass clas)
 406         | otherwise                        = tyConName tc
 407     get_main_name (AnId id)
 408         = case globalIdDetails id of
 409             DataConId     dc -> get_main_name (ATyCon (dataConTyCon dc))
 410             DataConWrapId dc -> get_main_name (ATyCon (dataConTyCon dc))
 411             RecordSelId lbl  -> get_main_name (ATyCon (fieldLabelTyCon lbl))
 412             other            -> idName id
 413
 414 updateVSlurp (imp_mods, imp_names) main_name
 415   | isHomeModule mod = (imp_mods,                     addOneToNameSet imp_names main_name)
 416   | otherwise        = (extendModuleSet imp_mods mod, imp_names)
 417   where
 418     mod = nameModule main_name
 419
 420 recordLocalSlurps new_names
 421   = getIfacesRn         `thenRn` \ ifaces ->
 422     setIfacesRn (ifaces { iSlurp  = iSlurp ifaces `unionNameSets` new_names })
 423 \end{code}
 424
 425
 426
 427 %*********************************************************
 428 %*                                                       *
 429 \subsection{Extracting the `gates'}
 430 %*                                                       *
 431 %*********************************************************
 432
 433 The gating story
 434 ~~~~~~~~~~~~~~~~~
 435 We want to avoid sucking in too many instance declarations.
 436 An instance decl is only useful if the types and classes mentioned in
 437 its 'head' are all available in the program being compiled.  E.g.
 438
 439         instance (..) => C (T1 a) (T2 b) where ...
 440
 441 is only useful if C, T1 and T2 are all "available".  So we keep
 442 instance decls that have been parsed from .hi files, but not yet
 443 slurped in, in a pool called the 'gated instance pool'.
 444 Each has its set of 'gates': {C, T1, T2} in the above example.
 445
 446 More precisely, the gates of a module are the types and classes
 447 that are mentioned in:
 448
 449         a) the source code
 450         b) the type of an Id that's mentioned in the source code
 451            [includes constructors and selectors]
 452         c) the RHS of a type synonym that is a gate
 453         d) the superclasses of a class that is a gate
 454         e) the context of an instance decl that is slurped in
 455
 456 We slurp in an instance decl from the gated instance pool iff
 457
 458         all its gates are either in the gates of the module,
 459         or are a previously-loaded tycon or class.
 460
 461 The latter constraint is because there might have been an instance
 462 decl slurped in during an earlier compilation, like this:
 463
 464         instance Foo a => Baz (Maybe a) where ...
 465
 466 In the module being compiled we might need (Baz (Maybe T)), where T
 467 is defined in this module, and hence we need (Foo T).  So @Foo@ becomes
 468 a gate.  But there's no way to 'see' that.  More generally, types
 469 might be involved as well:
 470
 471         instance Foo2 T a => Baz2 a where ...
 472
 473 Now we must treat T as a gate too, as well as Foo.  So the solution
 474 we adopt is:
 475
 476         we simply treat all previously-loaded
 477         tycons and classes as gates.
 478
 479 This gloss only affects ghc --make and ghc --interactive.
 480
 481
 482 Consructors and class operations
 483 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 484 When we import a declaration like
 485
 486         data T = T1 Wibble | T2 Wobble
 487
 488 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
 489 @T1@, @T2@ respectively are mentioned by the user program. If only
 490 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
 491 in useless instance decls for (say) @Eq Wibble@, when they can't
 492 possibly be useful.
 493
 494 And that's just what (b) says: we only treat T1's type as a gate if
 495 T1 is mentioned.  getGates, which deals with decls we are slurping in,
 496 has to be a bit careful, because a mention of T1 will slurp in T's whole
 497 declaration.
 498
 499 -----------------------------
 500 @getGates@ takes a newly imported (and renamed) decl, and the free
 501 vars of the source program, and extracts from the decl the gate names.
 502
 503 \begin{code}
 504 getGates :: FreeVars            -- Things mentioned in the source program
 505                                 -- Used for the cunning "constructors and
 506                                 -- class ops" story described 10 lines above.
 507          -> RenamedTyClDecl
 508          -> FreeVars
 509
 510 getGates source_fvs decl
 511   = get_gates (\n -> n `elemNameSet` source_fvs) decl
 512
 513 get_gates is_used (ForeignType {tcdName = tycon}) = unitNameSet tycon
 514 get_gates is_used (IfaceSig    {tcdType = ty})    = extractHsTyNames ty
 515 get_gates is_used (CoreDecl    {tcdType = ty})    = extractHsTyNames ty
 516
 517 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
 518   = (super_cls_and_sigs `addOneToNameSet` cls) `unionNameSets`
 519     implicitClassGates cls
 520   where
 521     super_cls_and_sigs = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
 522                                             (hsTyVarNames tvs)
 523     get (ClassOpSig n _ ty _)
 524         | is_used n = extractHsTyNames ty
 525         | otherwise = emptyFVs
 526
 527 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
 528   = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
 529         -- A type synonym type constructor isn't a "gate" for instance decls
 530
 531 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
 532   = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt)
 533                                              (visibleDataCons cons))
 534                        (hsTyVarNames tvs)
 535     `addOneToNameSet` tycon
 536   where
 537     get (ConDecl n _ tvs ctxt details _)
 538         | is_used n
 539                 -- If the constructor is method, get fvs from all its fields
 540         = delListFromNameSet (get_details details `plusFV`
 541                               extractHsCtxtTyNames ctxt)
 542                              (hsTyVarNames tvs)
 543     get (ConDecl n _ tvs ctxt (RecCon fields) _)
 544                 -- Even if the constructor isn't mentioned, the fields
 545                 -- might be, as selectors.  They can't mention existentially
 546                 -- bound tyvars (typechecker checks for that) so no need for
 547                 -- the deleteListFromNameSet part
 548         = foldr (plusFV . get_field) emptyFVs fields
 549
 550     get other_con = emptyFVs
 551
 552     get_details (VanillaCon tys) = plusFVs (map get_bang tys)
 553     get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
 554     get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
 555
 556     get_field (fs,t) | any is_used fs = get_bang t
 557                      | otherwise      = emptyFVs
 558
 559     get_bang bty = extractHsTyNames (getBangType bty)
 560
 561 implicitClassGates :: Name -> FreeVars
 562 implicitClassGates cls
 563         -- If we load class Num, add Integer to the free gates
 564         -- This takes account of the fact that Integer might be needed for
 565         -- defaulting, but we don't want to load Integer (and all its baggage)
 566         -- if there's no numeric stuff needed.
 567         -- Similarly for class Fractional and Double
 568         --
 569         -- NB: adding T to the gates will force T to be loaded
 570         --
 571         -- NB: If we load (say) Floating, we'll end up loading Fractional too,
 572         --     since Fractional is a superclass of Floating
 573   | cls `hasKey` numClassKey        = unitFV integerTyConName
 574   | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
 575   | otherwise                       = emptyFVs
 576 \end{code}
 577
 578 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
 579 thing rather than a declaration.
 580
 581 \begin{code}
 582 getWiredInGates :: TyThing -> FreeVars
 583 -- The TyThing is one that we already have in our type environment, either
 584 --      a) because the TyCon or Id is wired in, or
 585 --      b) from a previous compile
 586 -- Either way, we might have instance decls in the (persistent) collection
 587 -- of parsed-but-not-slurped instance decls that should be slurped in.
 588 -- This might be the first module that mentions both the type and the class
 589 -- for that instance decl, even though both the type and the class were
 590 -- mentioned in other modules, and hence are in the type environment
 591
 592 getWiredInGates (AnId the_id) = namesOfType (idType the_id)
 593 getWiredInGates (AClass cl)   = implicitClassGates (getName cl)
 594         -- The superclasses must also be previously
 595         -- loaded, and hence are automatically gates
 596         -- All previously-loaded classes are automatically gates
 597         -- See "The gating story" above
 598 getWiredInGates (ATyCon tc)
 599   | isSynTyCon tc = delListFromNameSet (namesOfType ty) (map getName tyvars)
 600   | otherwise     = unitFV (getName tc)
 601   where
 602     (tyvars,ty)  = getSynTyConDefn tc
 603
 604 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
 605 \end{code}
 606
 607 \begin{code}
 608 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameInstDecl)]
 609 getImportedInstDecls gates
 610   =     -- First, load any orphan-instance modules that aren't aready loaded
 611         -- Orphan-instance modules are recorded in the module dependecnies
 612     getIfacesRn                                         `thenRn` \ ifaces ->
 613     let
 614         orphan_mods =
 615           [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
 616     in
 617     loadOrphanModules orphan_mods                       `thenRn_`
 618
 619         -- Now we're ready to grab the instance declarations
 620         -- Find the un-gated ones and return them,
 621         -- removing them from the bag kept in Ifaces
 622     getIfacesRn                                         `thenRn` \ ifaces ->
 623     getTypeEnvRn                                        `thenRn` \ lookup ->
 624     let
 625         available n = n `elemNameSet` gates || isJust (lookup n)
 626                 -- See "The gating story" above for the isJust thing
 627
 628         (decls, new_insts) = selectGated available (iInsts ifaces)
 629     in
 630     setIfacesRn (ifaces { iInsts = new_insts })         `thenRn_`
 631
 632     traceRn (sep [text "getImportedInstDecls:",
 633                   nest 4 (fsep (map ppr gate_list)),
 634                   text "Slurped" <+> int (length decls) <+> text "instance declarations",
 635                   nest 4 (vcat (map ppr_brief_inst_decl decls))])       `thenRn_`
 636     returnRn decls
 637   where
 638     gate_list      = nameSetToList gates
 639
 640 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
 641   = case inst_ty of
 642         HsForAllTy _ _ tau -> ppr tau
 643         other              -> ppr inst_ty
 644
 645 getImportedRules :: RnMG [(Module,RdrNameRuleDecl)]
 646 getImportedRules
 647   | opt_IgnoreIfacePragmas = returnRn []
 648   | otherwise
 649   = getIfacesRn         `thenRn` \ ifaces ->
 650     getTypeEnvRn        `thenRn` \ lookup ->
 651     let
 652                 -- Slurp rules for anything that is slurped,
 653                 -- either now or previously
 654         gates              = iSlurp ifaces
 655         available n        = n `elemNameSet` gates || isJust (lookup n)
 656         (decls, new_rules) = selectGated available (iRules ifaces)
 657     in
 658     if null decls then
 659         returnRn []
 660     else
 661     setIfacesRn (ifaces { iRules = new_rules })              `thenRn_`
 662     traceRn (sep [text "getImportedRules:",
 663                   text "Slurped" <+> int (length decls) <+> text "rules"])   `thenRn_`
 664     returnRn decls
 665
 666 selectGated :: (Name->Bool) -> GatedDecls d
 667             -> ([(Module,d)], GatedDecls d)
 668 selectGated available (decl_bag, n_slurped)
 669         -- Select only those decls whose gates are *all* available
 670 #ifdef DEBUG
 671   | opt_NoPruneDecls    -- Just to try the effect of not gating at all
 672   = let
 673         decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag       -- Grab them all
 674     in
 675     (decls, (emptyBag, n_slurped + length decls))
 676
 677   | otherwise
 678 #endif
 679   = case foldrBag select ([], emptyBag) decl_bag of
 680         (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
 681   where
 682     select (gate_fn, decl) (yes, no)
 683         | gate_fn available  = (decl:yes, no)
 684         | otherwise          = (yes,      (gate_fn,decl) `consBag` no)
 685 \end{code}
 686
 687
 688 %*********************************************************
 689 %*                                                      *
 690 \subsection{Getting in a declaration}
 691 %*                                                      *
 692 %*********************************************************
 693
 694 \begin{code}
 695 importDecl :: Name -> RnMG ImportDeclResult
 696
 697 data ImportDeclResult
 698   = AlreadySlurped
 699   | InTypeEnv TyThing
 700   | HereItIs (Module, RdrNameTyClDecl)
 701
 702 importDecl name
 703   =     -- STEP 1: Check if we've slurped it in while compiling this module
 704     getIfacesRn                         `thenRn` \ ifaces ->
 705     if name `elemNameSet` iSlurp ifaces then
 706         returnRn AlreadySlurped
 707     else
 708
 709
 710         -- STEP 2: Check if it's already in the type environment
 711     getTypeEnvRn                        `thenRn` \ lookup ->
 712     case lookup name of {
 713         Just ty_thing
 714             |   name `elemNameEnv` wiredInThingEnv
 715             ->  -- When we find a wired-in name we must load its home
 716                 -- module so that we find any instance decls lurking therein
 717                 loadHomeInterface wi_doc name   `thenRn_`
 718                 returnRn (InTypeEnv ty_thing)
 719
 720             |   otherwise
 721             ->  -- Very important: record that we've seen it
 722                 -- See comments with recordTypeEnvSlurp
 723                 setIfacesRn (recordTypeEnvSlurp ifaces ty_thing)        `thenRn_`
 724                 returnRn (InTypeEnv ty_thing) ;
 725
 726         Nothing ->
 727
 728         -- STEP 3: OK, we have to slurp it in from an interface file
 729         --         First load the interface file
 730     traceRn nd_doc                      `thenRn_`
 731     loadHomeInterface nd_doc name       `thenRn_`
 732     getIfacesRn                         `thenRn` \ ifaces ->
 733
 734         -- STEP 4: Get the declaration out
 735     let
 736         (decls_map, _) = iDecls ifaces
 737     in
 738     case lookupNameEnv decls_map name of
 739       Just (avail,_,decl) -> setIfacesRn (recordDeclSlurp ifaces avail) `thenRn_`
 740                              returnRn (HereItIs decl)
 741
 742       Nothing -> addErrRn (getDeclErr name)     `thenRn_`
 743                  returnRn AlreadySlurped
 744     }
 745   where
 746     wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
 747     nd_doc = ptext SLIT("need decl for") <+> ppr name
 748
 749 \end{code}
 750
 751
 752 %********************************************************
 753 %*                                                      *
 754 \subsection{Checking usage information}
 755 %*                                                      *
 756 %********************************************************
 757
 758 @recompileRequired@ is called from the HscMain.   It checks whether
 759 a recompilation is required.  It needs access to the persistent state,
 760 finder, etc, because it may have to load lots of interface files to
 761 check their versions.
 762
 763 \begin{code}
 764 type RecompileRequired = Bool
 765 upToDate  = False       -- Recompile not required
 766 outOfDate = True        -- Recompile required
 767
 768 recompileRequired :: FilePath           -- Only needed for debug msgs
 769                   -> ModIface           -- Old interface
 770                   -> RnMG RecompileRequired
 771 recompileRequired iface_path iface
 772   = traceHiDiffsRn (text "Considering whether compilation is required for" <+> text iface_path <> colon)        `thenRn_`
 773
 774         -- Source code unchanged and no errors yet... carry on
 775     checkList [checkModUsage u | u <- mi_usages iface]
 776
 777 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
 778 checkList []             = returnRn upToDate
 779 checkList (check:checks) = check        `thenRn` \ recompile ->
 780                            if recompile then
 781                                 returnRn outOfDate
 782                            else
 783                                 checkList checks
 784 \end{code}
 785
 786 \begin{code}
 787 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
 788 -- Given the usage information extracted from the old
 789 -- M.hi file for the module being compiled, figure out
 790 -- whether M needs to be recompiled.
 791
 792 checkModUsage (mod_name, _, _, NothingAtAll)
 793         -- If CurrentModule.hi contains
 794         --      import Foo :: ;
 795         -- then that simply records that Foo lies below CurrentModule in the
 796         -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
 797         -- In this case we don't even want to open Foo's interface.
 798   = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
 799
 800 checkModUsage (mod_name, _, is_boot, whats_imported)
 801   =     -- Load the imported interface is possible
 802         -- We use tryLoadInterface, because failure is not an error
 803         -- (might just be that the old .hi file for this module is out of date)
 804         -- We use ImportByUser/ImportByUserSource as the 'from' flag,
 805         --      a) because we need to know whether to load the .hi-boot file
 806         --      b) because loadInterface things matters are amiss if we
 807         --         ImportBySystem an interface it knows nothing about
 808     let
 809         doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
 810         from    | is_boot   = ImportByUserSource
 811                 | otherwise = ImportByUser
 812     in
 813     traceHiDiffsRn (text "Checking usages for module" <+> ppr mod_name) `thenRn_`
 814     tryLoadInterface doc_str mod_name from      `thenRn` \ (iface, maybe_err) ->
 815
 816     case maybe_err of {
 817         Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
 818                                       ppr mod_name]) ;
 819                 -- Couldn't find or parse a module mentioned in the
 820                 -- old interface file.  Don't complain -- it might just be that
 821                 -- the current module doesn't need that import and it's been deleted
 822
 823         Nothing ->
 824     let
 825         new_vers      = mi_version iface
 826         new_decl_vers = vers_decls new_vers
 827     in
 828     case whats_imported of {    -- NothingAtAll dealt with earlier
 829
 830       Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers       `thenRn` \ recompile ->
 831                                  if recompile then
 832                                         out_of_date (ptext SLIT("...and I needed the whole module"))
 833                                  else
 834                                         returnRn upToDate ;
 835
 836       Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
 837
 838         -- CHECK MODULE
 839     checkModuleVersion old_mod_vers new_vers    `thenRn` \ recompile ->
 840     if not recompile then
 841         returnRn upToDate
 842     else
 843
 844         -- CHECK EXPORT LIST
 845     if checkExportList maybe_old_export_vers new_vers then
 846         out_of_date (ptext SLIT("Export list changed"))
 847     else
 848
 849         -- CHECK RULES
 850     if old_rule_vers /= vers_rules new_vers then
 851         out_of_date (ptext SLIT("Rules changed"))
 852     else
 853
 854         -- CHECK ITEMS ONE BY ONE
 855     checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]   `thenRn` \ recompile ->
 856     if recompile then
 857         returnRn outOfDate      -- This one failed, so just bail out now
 858     else
 859         up_to_date (ptext SLIT("...but the bits I use haven't."))
 860
 861     }}
 862
 863 ------------------------
 864 checkModuleVersion old_mod_vers new_vers
 865   | vers_module new_vers == old_mod_vers
 866   = up_to_date (ptext SLIT("Module version unchanged"))
 867
 868   | otherwise
 869   = out_of_date (ptext SLIT("Module version has changed"))
 870
 871 ------------------------
 872 checkExportList Nothing  new_vers = upToDate
 873 checkExportList (Just v) new_vers = v /= vers_exports new_vers
 874
 875 ------------------------
 876 checkEntityUsage new_vers (name,old_vers)
 877   = case lookupNameEnv new_vers name of
 878
 879         Nothing       ->        -- We used it before, but it ain't there now
 880                           out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
 881
 882         Just new_vers   -- It's there, but is it up to date?
 883           | new_vers == old_vers -> traceHiDiffsRn (text "Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenRn_`
 884                                     returnRn upToDate
 885           | otherwise            -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name, ppr
 886                                                       old_vers, ptext SLIT("->"), ppr new_vers])
 887
 888 up_to_date  msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
 889 out_of_date msg = traceHiDiffsRn msg `thenRn_` returnRn outOfDate
 890 \end{code}
 891
 892
 893 %*********************************************************
 894 %*                                                       *
 895 \subsection{Errors}
 896 %*                                                       *
 897 %*********************************************************
 898
 899 \begin{code}
 900 getDeclErr name
 901   = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
 902           ptext SLIT("from module") <+> quotes (ppr (nameModule name))
 903          ]
 904 \end{code}