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