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