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