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