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 ( visibleDataCons, isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
43 import Class ( className )
44 import Name ( Name {-instance NamedThing-}, nameOccName,
45 nameModule, isInternalName, 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 Maybe ( isJust )
62 import Util ( sortLt, seqList )
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 spec'd 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
163 -- a) Specifically: Detailed version info for imports
164 -- from modules in this package Gotten from iVSlurp plus
167 -- b) Everything: Just the module version for imports
168 -- from modules in other packages Gotten from iVSlurp plus
171 -- c) NothingAtAll: The name only of modules, Baz, in
172 -- this package that are 'below' us, but which we didn't need
173 -- at all (this is needed only to decide whether to open Baz.hi
174 -- or Baz.hi-boot higher up the tree). This happens when a
175 -- module, Foo, that we explicitly imported has 'import Baz' in
176 -- its interface file, recording that Baz is below Foo in the
177 -- module dependency hierarchy. We want to propagate this
178 -- info. These modules are in a combination of HIT/PIT and
181 -- d) NothingAtAll: The name only of all orphan modules
182 -- we know of (this is needed so that anyone who imports us can
183 -- find the orphan modules) These modules are in a combination
184 -- of HIT/PIT and iImpModInfo
186 import_info0 = foldModuleEnv mk_imp_info [] pit
187 import_info1 = foldModuleEnv mk_imp_info import_info0 hit
188 import_info = not_even_opened_imports ++ import_info1
190 -- Recall that iImpModInfo describes modules that have
191 -- been mentioned in the import lists of interfaces we
192 -- have opened, but which we have not even opened when
193 -- compiling this module
194 not_even_opened_imports =
195 [ (mod_name, orphans, is_boot, NothingAtAll)
196 | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ]
199 mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
200 mk_imp_info iface so_far
202 | Just ns <- lookupModuleEnv mv_map mod -- Case (a)
203 = go_for_it (Specifically mod_vers maybe_export_vers
204 (mk_import_items ns) rules_vers)
206 | mod `elemModuleSet` imp_pkg_mods -- Case (b)
207 = go_for_it (Everything mod_vers)
209 | import_all_mod -- Case (a) and (b); the import-all part
210 = if is_home_pkg_mod then
211 go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
212 -- Since the module isn't in the mv_map, presumably we
213 -- didn't actually import anything at all from it
215 go_for_it (Everything mod_vers)
217 | is_home_pkg_mod || has_orphans -- Case (c) or (d)
218 = go_for_it NothingAtAll
222 go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
224 mod = mi_module iface
225 mod_name = moduleName mod
226 is_home_pkg_mod = isHomeModule mod
227 version_info = mi_version iface
228 version_env = vers_decls version_info
229 mod_vers = vers_module version_info
230 rules_vers = vers_rules version_info
231 export_vers = vers_exports version_info
232 import_all_mod = mod_name `elem` import_all_mods
233 has_orphans = mi_orphan iface
235 -- The sort is to put them into canonical order
236 mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
237 let v = lookupVersion version_env n
240 lt_occ n1 n2 = nameOccName n1 < nameOccName n2
242 maybe_export_vers | import_all_mod = Just (vers_exports version_info)
243 | otherwise = Nothing
246 -- seq the list of ImportVersions returned: occasionally these
247 -- don't get evaluated for a while and we can end up hanging on to
248 -- the entire collection of Ifaces.
249 seqList import_info (returnRn import_info)
252 %*********************************************************
254 \subsection{Slurping declarations}
256 %*********************************************************
259 -------------------------------------------------------
260 slurpImpDecls source_fvs
261 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
263 -- The current slurped-set records all local things
264 slurpSourceRefs source_fvs `thenRn` \ (decls, needed) ->
266 -- Then get everything else
267 closeDecls decls needed
270 -------------------------------------------------------
271 slurpSourceRefs :: FreeVars -- Variables referenced in source
272 -> RnMG ([RenamedHsDecl],
273 FreeVars) -- Un-satisfied needs
274 -- The declaration (and hence home module) of each gate has
275 -- already been loaded
277 slurpSourceRefs source_fvs
278 = go_outer [] -- Accumulating decls
279 emptyFVs -- Unsatisfied needs
280 emptyFVs -- Accumulating gates
281 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
283 -- The outer loop repeatedly slurps the decls for the current gates
284 -- and the instance decls
286 -- The outer loop is needed because consider
287 -- instance Foo a => Baz (Maybe a) where ...
288 -- It may be that Baz and Maybe are used in the source module,
289 -- but not Foo; so we need to chase Foo too.
291 -- We also need to follow superclass refs. In particular, 'chasing Foo' must
292 -- include actually getting in Foo's class decl
293 -- class Wib a => Foo a where ..
294 -- so that its superclasses are discovered. The point is that Wib is a gate too.
295 -- We do this for tycons too, so that we look through type synonyms.
297 go_outer decls fvs all_gates []
298 = returnRn (decls, fvs)
300 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
301 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
302 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
303 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
304 rnIfaceInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
305 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
306 (nameSetToList (gates2 `minusNameSet` all_gates))
307 -- Knock out the all_gates because even if we don't slurp any new
308 -- decls we can get some apparently-new gates from wired-in names
309 -- and we get an infinite loop
311 go_inner (decls, fvs, gates) wanted_name
312 = importDecl wanted_name `thenRn` \ import_result ->
313 case import_result of
314 AlreadySlurped -> returnRn (decls, fvs, gates)
315 InTypeEnv ty_thing -> returnRn (decls, fvs, gates `plusFV` getWiredInGates ty_thing)
317 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
318 returnRn (TyClD new_decl : decls,
320 gates `plusFV` getGates source_fvs new_decl)
325 -------------------------------------------------------
326 -- closeDecls keeps going until the free-var set is empty
327 closeDecls decls needed
328 = slurpIfaceDecls decls needed `thenRn` \ decls1 ->
329 getImportedRules `thenRn` \ rule_decls ->
331 [] -> returnRn decls1 -- No new rules, so we are done
332 other -> rnIfaceDecls rnIfaceRuleDecl rule_decls `thenRn` \ rule_decls' ->
334 rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
336 traceRn (text "closeRules" <+> ppr rule_decls' $$
337 fsep (map ppr (nameSetToList rule_fvs))) `thenRn_`
338 closeDecls (map RuleD rule_decls' ++ decls1) rule_fvs
341 -------------------------------------------------------
342 -- Augment decls with any decls needed by needed,
343 -- and so on transitively
344 slurpIfaceDecls :: [RenamedHsDecl] -> FreeVars -> RnMG [RenamedHsDecl]
345 slurpIfaceDecls decls needed
346 = slurp decls (nameSetToList needed)
348 slurp decls [] = returnRn decls
349 slurp decls (n:ns) = slurp_one decls n `thenRn` \ decls1 ->
352 slurp_one decls wanted_name
353 = importDecl wanted_name `thenRn` \ import_result ->
354 case import_result of
355 HereItIs decl -> -- Found a declaration... rename it
356 -- and get the things it needs
357 rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs) ->
358 slurp (TyClD new_decl : decls) (nameSetToList fvs)
361 other -> -- No declaration... (wired in thing, or deferred,
362 -- or already slurped)
366 -------------------------------------------------------
367 rnIfaceDecls rn decls = mapRn (rnIfaceDecl rn) decls
368 rnIfaceDecl rn (mod, decl) = initIfaceRnMS mod (rn decl)
370 rnIfaceInstDecls decls fvs gates inst_decls
371 = rnIfaceDecls rnInstDecl inst_decls `thenRn` \ inst_decls' ->
372 returnRn (map InstD inst_decls' ++ decls,
373 fvs `plusFV` plusFVs (map instDeclFVs inst_decls'),
374 gates `plusFV` plusFVs (map getInstDeclGates inst_decls'))
376 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl) `thenRn` \ decl' ->
377 returnRn (decl', tyClDeclFVs decl')
382 recordDeclSlurp ifaces@(Ifaces { iDecls = (decls_map, n_slurped),
383 iSlurp = slurped_names,
386 = ASSERT2( not (isInternalName (availName avail)), ppr avail )
387 ifaces { iDecls = (new_decls_map, n_slurped+1),
388 iSlurp = new_slurped_names,
389 iVSlurp = updateVSlurp vslurp (availName avail) }
391 new_decls_map = foldl delFromNameEnv decls_map (availNames avail)
392 new_slurped_names = addAvailToNameSet slurped_names avail
395 -- recordTypeEnvSlurp is used when we slurp something that's
396 -- already in the type environment, that was not slurped in an earlier compilation.
397 -- We record it in the iVSlurp set, because that's used to
398 -- generate usage information
400 recordTypeEnvSlurp ifaces ty_thing
401 = ifaces { iVSlurp = updateVSlurp (iVSlurp ifaces) (get_main_name ty_thing) }
403 -- Tiresomely, we must get the "main" name for the
404 -- thing, because that's what VSlurp contains, and what
405 -- is recorded in the usage information
406 get_main_name (AClass cl) = className cl
407 get_main_name (ATyCon tc)
408 | Just clas <- tyConClass_maybe tc = get_main_name (AClass clas)
409 | otherwise = tyConName tc
410 get_main_name (AnId id)
411 = case globalIdDetails id of
412 DataConId dc -> get_main_name (ATyCon (dataConTyCon dc))
413 DataConWrapId dc -> get_main_name (ATyCon (dataConTyCon dc))
414 RecordSelId lbl -> get_main_name (ATyCon (fieldLabelTyCon lbl))
417 updateVSlurp (imp_mods, imp_names) main_name
418 | isHomeModule mod = (imp_mods, addOneToNameSet imp_names main_name)
419 | otherwise = (extendModuleSet imp_mods mod, imp_names)
421 mod = nameModule main_name
423 recordLocalSlurps new_names
424 = getIfacesRn `thenRn` \ ifaces ->
425 setIfacesRn (ifaces { iSlurp = iSlurp ifaces `unionNameSets` new_names })
430 %*********************************************************
432 \subsection{Extracting the `gates'}
434 %*********************************************************
438 We want to avoid sucking in too many instance declarations.
439 An instance decl is only useful if the types and classes mentioned in
440 its 'head' are all available in the program being compiled. E.g.
442 instance (..) => C (T1 a) (T2 b) where ...
444 is only useful if C, T1 and T2 are all "available". So we keep
445 instance decls that have been parsed from .hi files, but not yet
446 slurped in, in a pool called the 'gated instance pool'.
447 Each has its set of 'gates': {C, T1, T2} in the above example.
449 More precisely, the gates of a module are the types and classes
450 that are mentioned in:
453 b) the type of an Id that's mentioned in the source code
454 [includes constructors and selectors]
455 c) the RHS of a type synonym that is a gate
456 d) the superclasses of a class that is a gate
457 e) the context of an instance decl that is slurped in
459 We slurp in an instance decl from the gated instance pool iff
461 all its gates are either in the gates of the module,
462 or are a previously-loaded tycon or class.
464 The latter constraint is because there might have been an instance
465 decl slurped in during an earlier compilation, like this:
467 instance Foo a => Baz (Maybe a) where ...
469 In the module being compiled we might need (Baz (Maybe T)), where T
470 is defined in this module, and hence we need (Foo T). So @Foo@ becomes
471 a gate. But there's no way to 'see' that. More generally, types
472 might be involved as well:
474 instance Foo2 T a => Baz2 a where ...
476 Now we must treat T as a gate too, as well as Foo. So the solution
479 we simply treat all previously-loaded
480 tycons and classes as gates.
482 This gloss only affects ghc --make and ghc --interactive.
485 Consructors and class operations
486 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
487 When we import a declaration like
489 data T = T1 Wibble | T2 Wobble
491 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
492 @T1@, @T2@ respectively are mentioned by the user program. If only
493 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
494 in useless instance decls for (say) @Eq Wibble@, when they can't
497 And that's just what (b) says: we only treat T1's type as a gate if
498 T1 is mentioned. getGates, which deals with decls we are slurping in,
499 has to be a bit careful, because a mention of T1 will slurp in T's whole
502 -----------------------------
503 @getGates@ takes a newly imported (and renamed) decl, and the free
504 vars of the source program, and extracts from the decl the gate names.
507 getGates :: FreeVars -- Things mentioned in the source program
508 -- Used for the cunning "constructors and
509 -- class ops" story described 10 lines above.
513 getGates source_fvs decl
514 = get_gates (\n -> n `elemNameSet` source_fvs) decl
516 get_gates is_used (ForeignType {tcdName = tycon}) = unitNameSet tycon
517 get_gates is_used (IfaceSig {tcdType = ty}) = extractHsTyNames ty
518 get_gates is_used (CoreDecl {tcdType = ty}) = extractHsTyNames ty
520 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
521 = (super_cls_and_sigs `addOneToNameSet` cls) `unionNameSets`
522 implicitClassGates cls
524 super_cls_and_sigs = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
526 get (ClassOpSig n _ ty _)
527 | is_used n = extractHsTyNames ty
528 | otherwise = emptyFVs
530 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
531 = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
532 -- A type synonym type constructor isn't a "gate" for instance decls
534 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
535 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt)
536 (visibleDataCons cons))
538 `addOneToNameSet` tycon
540 get (ConDecl n _ tvs ctxt details _)
542 -- If the constructor is method, get fvs from all its fields
543 = delListFromNameSet (get_details details `plusFV`
544 extractHsCtxtTyNames ctxt)
546 get (ConDecl n _ tvs ctxt (RecCon fields) _)
547 -- Even if the constructor isn't mentioned, the fields
548 -- might be, as selectors. They can't mention existentially
549 -- bound tyvars (typechecker checks for that) so no need for
550 -- the deleteListFromNameSet part
551 = foldr (plusFV . get_field) emptyFVs fields
553 get other_con = emptyFVs
555 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
556 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
557 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
559 get_field (fs,t) | any is_used fs = get_bang t
560 | otherwise = emptyFVs
562 get_bang bty = extractHsTyNames (getBangType bty)
564 implicitClassGates :: Name -> FreeVars
565 implicitClassGates cls
566 -- If we load class Num, add Integer to the free gates
567 -- This takes account of the fact that Integer might be needed for
568 -- defaulting, but we don't want to load Integer (and all its baggage)
569 -- if there's no numeric stuff needed.
570 -- Similarly for class Fractional and Double
572 -- NB: adding T to the gates will force T to be loaded
574 -- NB: If we load (say) Floating, we'll end up loading Fractional too,
575 -- since Fractional is a superclass of Floating
576 | cls `hasKey` numClassKey = unitFV integerTyConName
577 | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
578 | otherwise = emptyFVs
581 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
582 thing rather than a declaration.
585 getWiredInGates :: TyThing -> FreeVars
586 -- The TyThing is one that we already have in our type environment, either
587 -- a) because the TyCon or Id is wired in, or
588 -- b) from a previous compile
589 -- Either way, we might have instance decls in the (persistent) collection
590 -- of parsed-but-not-slurped instance decls that should be slurped in.
591 -- This might be the first module that mentions both the type and the class
592 -- for that instance decl, even though both the type and the class were
593 -- mentioned in other modules, and hence are in the type environment
595 getWiredInGates (AnId the_id) = namesOfType (idType the_id)
596 getWiredInGates (AClass cl) = implicitClassGates (getName cl)
597 -- The superclasses must also be previously
598 -- loaded, and hence are automatically gates
599 -- All previously-loaded classes are automatically gates
600 -- See "The gating story" above
601 getWiredInGates (ATyCon tc)
602 | isSynTyCon tc = delListFromNameSet (namesOfType ty) (map getName tyvars)
603 | otherwise = unitFV (getName tc)
605 (tyvars,ty) = getSynTyConDefn tc
607 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
611 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameInstDecl)]
612 getImportedInstDecls gates
613 = -- First, load any orphan-instance modules that aren't aready loaded
614 -- Orphan-instance modules are recorded in the module dependecnies
615 getIfacesRn `thenRn` \ ifaces ->
618 [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
620 loadOrphanModules orphan_mods `thenRn_`
622 -- Now we're ready to grab the instance declarations
623 -- Find the un-gated ones and return them,
624 -- removing them from the bag kept in Ifaces
625 getIfacesRn `thenRn` \ ifaces ->
626 getTypeEnvRn `thenRn` \ lookup ->
628 available n = n `elemNameSet` gates || isJust (lookup n)
629 -- See "The gating story" above for the isJust thing
631 (decls, new_insts) = selectGated available (iInsts ifaces)
633 setIfacesRn (ifaces { iInsts = new_insts }) `thenRn_`
635 traceRn (sep [text "getImportedInstDecls:",
636 nest 4 (fsep (map ppr gate_list)),
637 text "Slurped" <+> int (length decls) <+> text "instance declarations",
638 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenRn_`
641 gate_list = nameSetToList gates
643 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
645 HsForAllTy _ _ tau -> ppr tau
648 getImportedRules :: RnMG [(Module,RdrNameRuleDecl)]
650 | opt_IgnoreIfacePragmas = returnRn []
652 = getIfacesRn `thenRn` \ ifaces ->
653 getTypeEnvRn `thenRn` \ lookup ->
655 -- Slurp rules for anything that is slurped,
656 -- either now or previously
657 gates = iSlurp ifaces
658 available n = n `elemNameSet` gates || isJust (lookup n)
659 (decls, new_rules) = selectGated available (iRules ifaces)
664 setIfacesRn (ifaces { iRules = new_rules }) `thenRn_`
665 traceRn (sep [text "getImportedRules:",
666 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenRn_`
669 selectGated :: (Name->Bool) -> GatedDecls d
670 -> ([(Module,d)], GatedDecls d)
671 selectGated available (decl_bag, n_slurped)
672 -- Select only those decls whose gates are *all* available
674 | opt_NoPruneDecls -- Just to try the effect of not gating at all
676 decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag -- Grab them all
678 (decls, (emptyBag, n_slurped + length decls))
682 = case foldrBag select ([], emptyBag) decl_bag of
683 (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
685 select (gate_fn, decl) (yes, no)
686 | gate_fn available = (decl:yes, no)
687 | otherwise = (yes, (gate_fn,decl) `consBag` no)
691 %*********************************************************
693 \subsection{Getting in a declaration}
695 %*********************************************************
698 importDecl :: Name -> RnMG ImportDeclResult
700 data ImportDeclResult
703 | HereItIs (Module, RdrNameTyClDecl)
706 = -- STEP 1: Check if we've slurped it in while compiling this module
707 getIfacesRn `thenRn` \ ifaces ->
708 if name `elemNameSet` iSlurp ifaces then
709 returnRn AlreadySlurped
713 -- STEP 2: Check if it's already in the type environment
714 getTypeEnvRn `thenRn` \ lookup ->
715 case lookup name of {
717 | name `elemNameEnv` wiredInThingEnv
718 -> -- When we find a wired-in name we must load its home
719 -- module so that we find any instance decls lurking therein
720 loadHomeInterface wi_doc name `thenRn_`
721 returnRn (InTypeEnv ty_thing)
724 -> -- Very important: record that we've seen it
725 -- See comments with recordTypeEnvSlurp
726 setIfacesRn (recordTypeEnvSlurp ifaces ty_thing) `thenRn_`
727 returnRn (InTypeEnv ty_thing) ;
731 -- STEP 3: OK, we have to slurp it in from an interface file
732 -- First load the interface file
733 traceRn nd_doc `thenRn_`
734 loadHomeInterface nd_doc name `thenRn_`
735 getIfacesRn `thenRn` \ ifaces ->
737 -- STEP 4: Get the declaration out
739 (decls_map, _) = iDecls ifaces
741 case lookupNameEnv decls_map name of
742 Just (avail,_,decl) -> setIfacesRn (recordDeclSlurp ifaces avail) `thenRn_`
743 returnRn (HereItIs decl)
745 Nothing -> addErrRn (getDeclErr name) `thenRn_`
746 returnRn AlreadySlurped
749 wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
750 nd_doc = ptext SLIT("need decl for") <+> ppr name
755 %********************************************************
757 \subsection{Checking usage information}
759 %********************************************************
761 @recompileRequired@ is called from the HscMain. It checks whether
762 a recompilation is required. It needs access to the persistent state,
763 finder, etc, because it may have to load lots of interface files to
764 check their versions.
767 type RecompileRequired = Bool
768 upToDate = False -- Recompile not required
769 outOfDate = True -- Recompile required
771 recompileRequired :: FilePath -- Only needed for debug msgs
772 -> ModIface -- Old interface
773 -> RnMG RecompileRequired
774 recompileRequired iface_path iface
775 = traceHiDiffsRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
777 -- Source code unchanged and no errors yet... carry on
778 checkList [checkModUsage u | u <- mi_usages iface]
780 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
781 checkList [] = returnRn upToDate
782 checkList (check:checks) = check `thenRn` \ recompile ->
790 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
791 -- Given the usage information extracted from the old
792 -- M.hi file for the module being compiled, figure out
793 -- whether M needs to be recompiled.
795 checkModUsage (mod_name, _, _, NothingAtAll)
796 -- If CurrentModule.hi contains
798 -- then that simply records that Foo lies below CurrentModule in the
799 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
800 -- In this case we don't even want to open Foo's interface.
801 = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
803 checkModUsage (mod_name, _, is_boot, whats_imported)
804 = -- Load the imported interface is possible
805 -- We use tryLoadInterface, because failure is not an error
806 -- (might just be that the old .hi file for this module is out of date)
807 -- We use ImportByUser/ImportByUserSource as the 'from' flag,
808 -- a) because we need to know whether to load the .hi-boot file
809 -- b) because loadInterface things matters are amiss if we
810 -- ImportBySystem an interface it knows nothing about
812 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
813 from | is_boot = ImportByUserSource
814 | otherwise = ImportByUser
816 traceHiDiffsRn (text "Checking usages for module" <+> ppr mod_name) `thenRn_`
817 tryLoadInterface doc_str mod_name from `thenRn` \ (iface, maybe_err) ->
820 Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
822 -- Couldn't find or parse a module mentioned in the
823 -- old interface file. Don't complain -- it might just be that
824 -- the current module doesn't need that import and it's been deleted
828 new_vers = mi_version iface
829 new_decl_vers = vers_decls new_vers
831 case whats_imported of { -- NothingAtAll dealt with earlier
833 Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
835 out_of_date (ptext SLIT("...and I needed the whole module"))
839 Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
842 checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
843 if not recompile then
848 if checkExportList maybe_old_export_vers new_vers then
849 out_of_date (ptext SLIT("Export list changed"))
853 if old_rule_vers /= vers_rules new_vers then
854 out_of_date (ptext SLIT("Rules changed"))
857 -- CHECK ITEMS ONE BY ONE
858 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenRn` \ recompile ->
860 returnRn outOfDate -- This one failed, so just bail out now
862 up_to_date (ptext SLIT("...but the bits I use haven't."))
866 ------------------------
867 checkModuleVersion old_mod_vers new_vers
868 | vers_module new_vers == old_mod_vers
869 = up_to_date (ptext SLIT("Module version unchanged"))
872 = out_of_date (ptext SLIT("Module version has changed"))
874 ------------------------
875 checkExportList Nothing new_vers = upToDate
876 checkExportList (Just v) new_vers = v /= vers_exports new_vers
878 ------------------------
879 checkEntityUsage new_vers (name,old_vers)
880 = case lookupNameEnv new_vers name of
882 Nothing -> -- We used it before, but it ain't there now
883 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
885 Just new_vers -- It's there, but is it up to date?
886 | new_vers == old_vers -> traceHiDiffsRn (text "Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenRn_`
888 | otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name, ppr
889 old_vers, ptext SLIT("->"), ppr new_vers])
891 up_to_date msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
892 out_of_date msg = traceHiDiffsRn msg `thenRn_` returnRn outOfDate
896 %*********************************************************
900 %*********************************************************
904 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
905 ptext SLIT("from module") <+> quotes (ppr (nameModule name))