2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \%[RnIfaces]{Cacheing and Renaming of Interfaces}
8 ( slurpImpDecls, importSupportingDecls,
9 RecompileRequired, outOfDate, upToDate, checkVersions
13 #include "HsVersions.h"
15 import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_NoPruneDecls )
17 import HsSyn ( HsDecl(..), Sig(..), TyClDecl(..), ConDecl(..), HsConDetails(..),
18 InstDecl(..), HsType(..), hsTyVarNames, getBangType
20 import RdrHsSyn ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
21 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl,
22 extractHsTyNames, extractHsCtxtTyNames,
23 tyClDeclFVs, ruleDeclFVs, impDeclFVs
25 import RnHiFiles ( loadInterface, loadHomeInterface, loadOrphanModules )
26 import RnNames ( mkModDeps )
27 import RnSource ( rnTyClDecl, rnInstDecl, rnIfaceRuleDecl )
28 import TcEnv ( getInGlobalScope, tcLookupGlobal_maybe )
30 import Id ( idType, idName, globalIdDetails )
31 import IdInfo ( GlobalIdDetails(..) )
32 import TcType ( tyClsNamesOfType, classNamesOfTheta )
33 import FieldLabel ( fieldLabelTyCon )
34 import DataCon ( dataConTyCon )
35 import TyCon ( visibleDataCons, isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
36 import Class ( className, classSCTheta )
37 import Name ( Name {-instance NamedThing-}, isWiredInName, isInternalName, nameModule, NamedThing(..)
39 import NameEnv ( delFromNameEnv, lookupNameEnv )
41 import Module ( Module, isHomeModule, extendModuleSet, moduleEnvElts )
42 import PrelNames ( hasKey, fractionalClassKey, numClassKey,
43 integerTyConName, doubleTyConName )
47 import Maybe( fromJust )
51 %*********************************************************
53 \subsection{Slurping declarations}
55 %*********************************************************
58 -------------------------------------------------------
59 slurpImpDecls :: FreeVars -> TcRn m [RenamedHsDecl]
60 slurpImpDecls source_fvs
61 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenM_`
63 -- Slurp in things which might be 'gates' for instance
64 -- declarations, plus the instance declarations themselves
65 slurpSourceRefs source_fvs `thenM` \ (gate_decls, bndrs) ->
67 -- Then get everything else
69 needed = foldr (plusFV . impDeclFVs) emptyFVs gate_decls
71 import_supporting_decls (gate_decls, bndrs) needed
74 -------------------------------------------------------
75 slurpSourceRefs :: FreeVars -- Variables referenced in source
76 -> TcRn m ([RenamedHsDecl], -- Needed declarations
77 NameSet) -- Names bound by those declarations
78 -- Slurp imported declarations needed directly by the source code;
79 -- and some of the ones they need. The goal is to find all the 'gates'
80 -- for instance declarations.
82 slurpSourceRefs source_fvs
83 = go_outer [] emptyFVs -- Accumulating decls
84 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
86 -- The outer loop repeatedly slurps the decls for the current gates
87 -- and the instance decls
89 -- The outer loop is needed because consider
90 -- instance Foo a => Baz (Maybe a) where ...
91 -- It may be that Baz and Maybe are used in the source module,
92 -- but not Foo; so we need to chase Foo too.
94 -- We also need to follow superclass refs. In particular, 'chasing Foo' must
95 -- include actually getting in Foo's class decl
96 -- class Wib a => Foo a where ..
97 -- so that its superclasses are discovered. The point is that Wib is a gate too.
98 -- We do this for tycons too, so that we look through type synonyms.
100 go_outer decls bndrs [] = returnM (decls, bndrs)
102 go_outer decls bndrs refs -- 'refs' are not necessarily slurped yet
103 = traceRn (text "go_outer" <+> ppr refs) `thenM_`
104 foldlM go_inner (decls, bndrs, emptyFVs) refs `thenM` \ (decls1, bndrs1, gates1) ->
105 getImportedInstDecls gates1 `thenM` \ (inst_decls, new_gates) ->
106 rnIfaceDecls rnInstDecl inst_decls `thenM` \ inst_decls' ->
107 go_outer (map InstD inst_decls' ++ decls1)
109 (nameSetToList (new_gates `plusFV` plusFVs (map getInstDeclGates inst_decls')))
110 -- NB: we go round again to fetch the decls for any gates of any decls
111 -- we have loaded. For example, if we mention
112 -- print :: Show a => a -> String
113 -- then we must load the decl for Show before stopping, to ensure
114 -- that instances from its home module are available
116 go_inner (decls, bndrs, gates) wanted_name
117 = importDecl bndrs wanted_name `thenM` \ import_result ->
118 case import_result of
119 AlreadySlurped -> returnM (decls, bndrs, gates)
123 bndrs `addOneFV` wanted_name, -- Avoid repeated calls to getWiredInGates
124 gates `plusFV` getWiredInGates ty_thing)
126 HereItIs decl new_bndrs
127 -> rnIfaceDecl rnTyClDecl decl `thenM` \ new_decl ->
128 returnM (TyClD new_decl : decls,
129 bndrs `plusFV` new_bndrs,
130 gates `plusFV` getGates source_fvs new_decl)
134 -------------------------------------------------------
135 -- import_supporting_decls keeps going until the free-var set is empty
136 importSupportingDecls needed
137 = import_supporting_decls ([], emptyNameSet) needed
139 import_supporting_decls
140 :: ([RenamedHsDecl], NameSet) -- Some imported decls, with their binders
141 -> FreeVars -- Remaining un-slurped names
142 -> TcRn m [RenamedHsDecl]
143 import_supporting_decls decls needed
144 = slurpIfaceDecls decls needed `thenM` \ (decls1, bndrs1) ->
145 getImportedRules bndrs1 `thenM` \ rule_decls ->
147 [] -> returnM decls1 -- No new rules, so we are done
148 other -> rnIfaceDecls rnIfaceRuleDecl rule_decls `thenM` \ rule_decls' ->
150 rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
151 decls2 = decls1 ++ map RuleD rule_decls'
153 traceRn (text "closeRules" <+> ppr rule_decls' $$
154 fsep (map ppr (nameSetToList rule_fvs))) `thenM_`
155 import_supporting_decls (decls2, bndrs1) rule_fvs
158 -------------------------------------------------------
159 -- Augment decls with any decls needed by needed,
160 -- and so on transitively
161 slurpIfaceDecls :: ([RenamedHsDecl], NameSet) -- Already slurped
162 -> FreeVars -- Still needed
163 -> TcRn m ([RenamedHsDecl], NameSet)
164 slurpIfaceDecls (decls, bndrs) needed
165 = slurp decls bndrs (nameSetToList needed)
167 slurp decls bndrs [] = returnM (decls, bndrs)
168 slurp decls bndrs (n:ns)
169 = importDecl bndrs n `thenM` \ import_result ->
170 case import_result of
171 HereItIs decl new_bndrs -- Found a declaration... rename it
172 -> rnIfaceDecl rnTyClDecl decl `thenM` \ new_decl ->
173 slurp (TyClD new_decl : decls)
174 (bndrs `plusFV` new_bndrs)
175 (nameSetToList (tyClDeclFVs new_decl) ++ ns)
178 other -> -- No declaration... (wired in thing, or deferred,
179 -- or already slurped)
180 slurp decls (bndrs `addOneFV` n) ns
182 -------------------------------------------------------
183 rnIfaceDecls rn decls = mappM (rnIfaceDecl rn) decls
184 rnIfaceDecl rn (mod, decl) = initRn (InterfaceMode mod) (rn decl)
189 -- Tiresomely, we must get the "main" name for the
190 -- thing, because that's what VSlurp contains, and what
191 -- is recorded in the usage information
192 get_main_name (AClass cl) = className cl
193 get_main_name (ATyCon tc)
194 | Just clas <- tyConClass_maybe tc = get_main_name (AClass clas)
195 | otherwise = tyConName tc
196 get_main_name (AnId id)
197 = case globalIdDetails id of
198 DataConId dc -> get_main_name (ATyCon (dataConTyCon dc))
199 DataConWrapId dc -> get_main_name (ATyCon (dataConTyCon dc))
200 RecordSelId lbl -> get_main_name (ATyCon (fieldLabelTyCon lbl))
204 recordUsage :: Name -> TcRn m ()
205 -- Record that the Name has been used, for
206 -- later generation of usage info in the interface file
207 recordUsage name = updUsages (upd_usg name)
210 | isHomeModule mod = addOneToNameSet usages name
213 mod = nameModule name
217 %*********************************************************
219 \subsection{Getting in a declaration}
221 %*********************************************************
224 importDecl :: NameSet -> Name -> TcRn m ImportDeclResult
226 data ImportDeclResult
229 | HereItIs (Module, RdrNameTyClDecl) NameSet
230 -- The NameSet is the bunch of names bound by this decl
232 importDecl already_slurped name
233 = -- STEP 0: Check if it's from this module
234 -- Doing this catches a common case quickly
235 getModule `thenM` \ this_mod ->
236 if isInternalName name || nameModule name == this_mod then
237 -- Variables defined on the GHCi command line (e.g. let x = 3)
238 -- are Internal names (which don't have a Module)
239 returnM AlreadySlurped
242 -- STEP 1: Check if we've slurped it in while compiling this module
243 if name `elemNameSet` already_slurped then
244 returnM AlreadySlurped
247 -- STEP 2: Check if it's already in the type environment
248 tcLookupGlobal_maybe name `thenM` \ maybe_thing ->
249 case maybe_thing of {
253 -> -- When we find a wired-in name we must load its home
254 -- module so that we find any instance decls lurking therein
255 loadHomeInterface wi_doc name `thenM_`
256 returnM (InTypeEnv ty_thing)
259 -> -- We have slurp something that's already in the type environment,
260 -- that was not slurped in an earlier compilation.
261 -- Must still record it in the Usages info, because that's used to
262 -- generate usage information
264 traceRn (text "not wired in" <+> ppr name) `thenM_`
265 recordUsage (get_main_name ty_thing) `thenM_`
266 returnM (InTypeEnv ty_thing) ;
270 -- STEP 4: OK, we have to slurp it in from an interface file
271 -- First load the interface file
272 traceRn nd_doc `thenM_`
273 loadHomeInterface nd_doc name `thenM_`
275 -- STEP 4: Get the declaration out
276 getEps `thenM` \ eps ->
278 (decls_map, n_slurped) = eps_decls eps
280 case lookupNameEnv decls_map name of
281 Just (avail,_,decl) -> setEps eps' `thenM_`
282 recordUsage (availName avail) `thenM_`
283 returnM (HereItIs decl (mkFVs avail_names))
285 avail_names = availNames avail
286 new_decls_map = foldl delFromNameEnv decls_map avail_names
287 eps' = eps { eps_decls = (new_decls_map, n_slurped+1) }
289 Nothing -> addErr (getDeclErr name) `thenM_`
290 returnM AlreadySlurped
293 wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
294 nd_doc = ptext SLIT("need decl for") <+> ppr name
299 %*********************************************************
301 \subsection{Extracting the `gates'}
303 %*********************************************************
307 We want to avoid sucking in too many instance declarations.
308 An instance decl is only useful if the types and classes mentioned in
309 its 'head' are all available in the program being compiled. E.g.
311 instance (..) => C (T1 a) (T2 b) where ...
313 is only useful if C, T1 and T2 are all "available". So we keep
314 instance decls that have been parsed from .hi files, but not yet
315 slurped in, in a pool called the 'gated instance pool'.
316 Each has its set of 'gates': {C, T1, T2} in the above example.
318 More precisely, the gates of a module are the types and classes
319 that are mentioned in:
321 a) the source code [Note: in fact these don't seem
322 to be treated as gates, perhaps
323 because no imported instance decl
324 can mention them; mutter mutter
326 b) the type of an Id that's mentioned in the source code
327 [includes constructors and selectors]
328 c) the RHS of a type synonym that is a gate
329 d) the superclasses of a class that is a gate
330 e) the context of an instance decl that is slurped in
332 We slurp in an instance decl from the gated instance pool iff
334 all its gates are either in the gates of the module,
335 or the gates of a previously-loaded module
337 The latter constraint is because there might have been an instance
338 decl slurped in during an earlier compilation, like this:
340 instance Foo a => Baz (Maybe a) where ...
342 In the module being compiled we might need (Baz (Maybe T)), where T is
343 defined in this module, and hence we need the instance for (Foo T).
344 So @Foo@ becomes a gate. But there's no way to 'see' that. More
345 generally, types might be involved as well:
347 instance Foo2 S a => Baz2 a where ...
349 Now we must treat S as a gate too, as well as Foo2. So the solution
352 we simply treat the gates of all previously-loaded
353 modules as gates of this one
355 So the gates are remembered across invocations of the renamer in the
356 PersistentRenamerState. This gloss mainly affects ghc --make and ghc
359 (We used to use the persistent type environment for this purpose,
360 but it has too much. For a start, it contains all tuple types,
361 because they are in the wired-in type env!)
364 Consructors and class operations
365 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
366 When we import a declaration like
368 data T = T1 Wibble | T2 Wobble
370 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
371 @T1@, @T2@ respectively are mentioned by the user program. If only
372 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
373 in useless instance decls for (say) @Eq Wibble@, when they can't
376 And that's just what (b) says: we only treat T1's type as a gate if
377 T1 is mentioned. getGates, which deals with decls we are slurping in,
378 has to be a bit careful, because a mention of T1 will slurp in T's whole
381 -----------------------------
382 @getGates@ takes a newly imported (and renamed) decl, and the free
383 vars of the source program, and extracts from the decl the gate names.
386 getGates :: FreeVars -- Things mentioned in the source program
387 -- Used for the cunning "constructors and
388 -- class ops" story described 10 lines above.
392 getGates source_fvs decl
393 = get_gates (\n -> n `elemNameSet` source_fvs) decl
395 get_gates is_used (ForeignType {tcdName = tycon}) = unitNameSet tycon
396 get_gates is_used (IfaceSig {tcdType = ty}) = extractHsTyNames ty
398 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
399 = (super_cls_and_sigs `addOneToNameSet` cls) `unionNameSets`
400 implicitClassGates cls
402 super_cls_and_sigs = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
404 get (ClassOpSig n _ ty _)
405 | is_used n = extractHsTyNames ty
406 | otherwise = emptyFVs
408 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
409 = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
410 -- A type synonym type constructor isn't a "gate" for instance decls
412 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
413 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt)
414 (visibleDataCons cons))
416 `addOneToNameSet` tycon
418 get (ConDecl n tvs ctxt details _)
420 -- If the constructor is method, get fvs from all its fields
421 = delListFromNameSet (get_details details `plusFV`
422 extractHsCtxtTyNames ctxt)
424 get (ConDecl n tvs ctxt (RecCon fields) _)
425 -- Even if the constructor isn't mentioned, the fields
426 -- might be, as selectors. They can't mention existentially
427 -- bound tyvars (typechecker checks for that) so no need for
428 -- the deleteListFromNameSet part
429 = foldr (plusFV . get_field) emptyFVs fields
431 get other_con = emptyFVs
433 get_details (PrefixCon tys) = plusFVs (map get_bang tys)
434 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
435 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
437 get_field (f,t) | is_used f = get_bang t
438 | otherwise = emptyFVs
440 get_bang bty = extractHsTyNames (getBangType bty)
442 implicitClassGates :: Name -> FreeVars
443 implicitClassGates cls
444 -- If we load class Num, add Integer to the free gates
445 -- This takes account of the fact that Integer might be needed for
446 -- defaulting, but we don't want to load Integer (and all its baggage)
447 -- if there's no numeric stuff needed.
448 -- Similarly for class Fractional and Double
450 -- NB: adding T to the gates will force T to be loaded
452 -- NB: If we load (say) Floating, we'll end up loading Fractional too,
453 -- since Fractional is a superclass of Floating
454 | cls `hasKey` numClassKey = unitFV integerTyConName
455 | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
456 | otherwise = emptyFVs
459 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
460 thing rather than a declaration.
463 getWiredInGates :: TyThing -> FreeVars
464 -- The TyThing is one that we already have in our type environment, either
465 -- a) because the TyCon or Id is wired in, or
466 -- b) from a previous compile
468 -- Either way, we might have instance decls in the (persistent) collection
469 -- of parsed-but-not-slurped instance decls that should be slurped in.
470 -- This might be the first module that mentions both the type and the class
471 -- for that instance decl, even though both the type and the class were
472 -- mentioned in other modules, and hence are in the type environment
474 getWiredInGates (AClass cl)
475 = unitFV (getName cl) `plusFV` mkFVs super_classes
477 super_classes = classNamesOfTheta (classSCTheta cl)
479 getWiredInGates (AnId the_id) = tyClsNamesOfType (idType the_id)
480 getWiredInGates (ATyCon tc)
481 | isSynTyCon tc = tyClsNamesOfType ty
482 | otherwise = unitFV (getName tc)
484 (_,ty) = getSynTyConDefn tc
486 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
490 getImportedInstDecls :: NameSet -> TcRn m ([(Module,RdrNameInstDecl)], NameSet)
491 -- Returns the gates that are new since last time
492 getImportedInstDecls gates
493 = -- First, load any orphan-instance modules that aren't aready loaded
494 -- Orphan-instance modules are recorded in the module dependecnies
495 getImports `thenM` \ imports ->
496 getEps `thenM` \ eps ->
498 old_gates = eps_inst_gates eps
499 new_gates = gates `minusNameSet` old_gates
500 all_gates = new_gates `unionNameSets` old_gates
501 orphan_mods = imp_orphs imports
503 loadOrphanModules orphan_mods `thenM_`
505 -- Now we're ready to grab the instance declarations
506 -- Find the un-gated ones and return them,
507 -- removing them from the bag kept in EPS
508 -- Don't foget to get the EPS a second time...
509 -- loadOrphanModules may have side-effected it!
510 getEps `thenM` \ eps ->
512 available n = n `elemNameSet` all_gates
513 (decls, new_insts) = selectGated available (eps_insts eps)
515 setEps (eps { eps_insts = new_insts,
516 eps_inst_gates = all_gates }) `thenM_`
518 traceRn (sep [text "getImportedInstDecls:",
519 nest 4 (fsep (map ppr (nameSetToList gates))),
520 nest 4 (fsep (map ppr (nameSetToList all_gates))),
521 nest 4 (fsep (map ppr (nameSetToList new_gates))),
522 text "Slurped" <+> int (length decls) <+> text "instance declarations",
523 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenM_`
524 returnM (decls, new_gates)
526 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
528 HsForAllTy _ _ tau -> ppr tau
531 getImportedRules :: NameSet -- Slurped already
532 -> TcRn m [(Module,RdrNameRuleDecl)]
533 getImportedRules slurped
534 | opt_IgnoreIfacePragmas = returnM []
536 = getEps `thenM` \ eps ->
537 getInGlobalScope `thenM` \ in_type_env ->
539 -- Slurp rules for anything that is slurped,
540 -- either now, or previously
541 available n = n `elemNameSet` slurped || in_type_env n
542 (decls, new_rules) = selectGated available (eps_rules eps)
547 setEps (eps { eps_rules = new_rules }) `thenM_`
548 traceRn (sep [text "getImportedRules:",
549 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenM_`
552 selectGated :: (Name->Bool) -> GatedDecls d
553 -> ([(Module,d)], GatedDecls d)
554 selectGated available (decl_bag, n_slurped)
555 -- Select only those decls whose gates are *all* available
557 | opt_NoPruneDecls -- Just to try the effect of not gating at all
559 decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag -- Grab them all
561 (decls, (emptyBag, n_slurped + length decls))
565 = case foldrBag select ([], emptyBag) decl_bag of
566 (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
568 select (gate_fn, decl) (yes, no)
569 | gate_fn available = (decl:yes, no)
570 | otherwise = (yes, (gate_fn,decl) `consBag` no)
574 %********************************************************
576 \subsection{Checking usage information}
578 %********************************************************
580 @recompileRequired@ is called from the HscMain. It checks whether
581 a recompilation is required. It needs access to the persistent state,
582 finder, etc, because it may have to load lots of interface files to
583 check their versions.
586 type RecompileRequired = Bool
587 upToDate = False -- Recompile not required
588 outOfDate = True -- Recompile required
590 checkVersions :: Bool -- True <=> source unchanged
591 -> ModIface -- Old interface
592 -> TcRn m RecompileRequired
593 checkVersions source_unchanged iface
594 | not source_unchanged
597 = traceHiDiffs (text "Considering whether compilation is required for" <+>
598 ppr (mi_module iface) <> colon) `thenM_`
600 -- Source code unchanged and no errors yet... carry on
601 -- First put the dependent-module info in the envt, just temporarily,
602 -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
603 -- It's just temporary because either the usage check will succeed
604 -- (in which case we are done with this module) or it'll fail (in which
605 -- case we'll compile the module from scratch anyhow).
606 updGblEnv (\ gbl -> gbl { tcg_imports = mod_deps }) (
607 checkList [checkModUsage u | u <- mi_usages iface]
611 -- This is a bit of a hack really
612 mod_deps = emptyImportAvails { imp_dep_mods = mkModDeps (dep_mods (mi_deps iface)) }
614 checkList :: [TcRn m RecompileRequired] -> TcRn m RecompileRequired
615 checkList [] = returnM upToDate
616 checkList (check:checks) = check `thenM` \ recompile ->
624 checkModUsage :: Usage Name -> TcRn m RecompileRequired
625 -- Given the usage information extracted from the old
626 -- M.hi file for the module being compiled, figure out
627 -- whether M needs to be recompiled.
629 checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
630 usg_rules = old_rule_vers,
631 usg_exports = maybe_old_export_vers,
632 usg_entities = old_decl_vers })
633 = -- Load the imported interface is possible
635 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
637 traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
639 tryM (loadInterface doc_str mod_name ImportBySystem) `thenM` \ mb_iface ->
642 Left exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
644 -- Couldn't find or parse a module mentioned in the
645 -- old interface file. Don't complain -- it might just be that
646 -- the current module doesn't need that import and it's been deleted
650 new_vers = mi_version iface
651 new_mod_vers = vers_module new_vers
652 new_decl_vers = vers_decls new_vers
653 new_export_vers = vers_exports new_vers
654 new_rule_vers = vers_rules new_vers
657 checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
658 if not recompile then
663 if checkExportList maybe_old_export_vers new_export_vers then
664 out_of_date_vers (ptext SLIT(" Export list changed"))
665 (fromJust maybe_old_export_vers)
670 if old_rule_vers /= new_rule_vers then
671 out_of_date_vers (ptext SLIT(" Rules changed"))
672 old_rule_vers new_rule_vers
675 -- CHECK ITEMS ONE BY ONE
676 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenM` \ recompile ->
678 returnM outOfDate -- This one failed, so just bail out now
680 up_to_date (ptext SLIT(" Great! The bits I use are up to date"))
684 ------------------------
685 checkModuleVersion old_mod_vers new_mod_vers
686 | new_mod_vers == old_mod_vers
687 = up_to_date (ptext SLIT("Module version unchanged"))
690 = out_of_date_vers (ptext SLIT(" Module version has changed"))
691 old_mod_vers new_mod_vers
693 ------------------------
694 checkExportList Nothing new_vers = upToDate
695 checkExportList (Just v) new_vers = v /= new_vers
697 ------------------------
698 checkEntityUsage new_vers (name,old_vers)
699 = case lookupNameEnv new_vers name of
701 Nothing -> -- We used it before, but it ain't there now
702 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
704 Just new_vers -- It's there, but is it up to date?
705 | new_vers == old_vers -> traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
707 | otherwise -> out_of_date_vers (ptext SLIT(" Out of date:") <+> ppr name)
710 up_to_date msg = traceHiDiffs msg `thenM_` returnM upToDate
711 out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
712 out_of_date_vers msg old_vers new_vers
713 = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])
717 %*********************************************************
721 %*********************************************************
725 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
726 ptext SLIT("from module") <+> quotes (ppr (nameModule name))