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, dataConWrapId )
35 import TyCon ( visibleDataCons, isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
36 import Class ( className, classSCTheta )
37 import Name ( Name {-instance NamedThing-}, isWiredInName, nameIsLocalOrFrom,
38 nameModule, NamedThing(..) )
39 import NameEnv ( delFromNameEnv, lookupNameEnv )
41 import Module ( Module, isHomeModule )
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 (ADataCon dc) = tyConName (dataConTyCon dc)
194 get_main_name (ATyCon tc)
195 | Just clas <- tyConClass_maybe tc = get_main_name (AClass clas)
196 | otherwise = tyConName tc
197 get_main_name (AnId id)
198 = case globalIdDetails id of
199 DataConWorkId dc -> get_main_name (ATyCon (dataConTyCon dc))
200 DataConWrapId dc -> get_main_name (ATyCon (dataConTyCon dc))
201 RecordSelId lbl -> get_main_name (ATyCon (fieldLabelTyCon lbl))
205 recordUsage :: Name -> TcRn m ()
206 -- Record that the Name has been used, for
207 -- later generation of usage info in the interface file
208 recordUsage name = updUsages (upd_usg name)
211 | isHomeModule mod = addOneToNameSet usages name
214 mod = nameModule name
218 %*********************************************************
220 \subsection{Getting in a declaration}
222 %*********************************************************
225 importDecl :: NameSet -> Name -> TcRn m ImportDeclResult
227 data ImportDeclResult
230 | HereItIs (Module, RdrNameTyClDecl) NameSet
231 -- The NameSet is the bunch of names bound by this decl
233 importDecl already_slurped name
234 = -- STEP 0: Check if it's from this module
235 -- Doing this catches a common case quickly
236 getModule `thenM` \ this_mod ->
237 if nameIsLocalOrFrom this_mod name then
238 -- Variables defined on the GHCi command line (e.g. let x = 3)
239 -- are Internal names (which don't have a Module)
240 returnM AlreadySlurped
243 -- STEP 1: Check if we've slurped it in while compiling this module
244 if name `elemNameSet` already_slurped then
245 returnM AlreadySlurped
248 -- STEP 2: Check if it's already in the type environment
249 tcLookupGlobal_maybe name `thenM` \ maybe_thing ->
250 case maybe_thing of {
254 -> -- When we find a wired-in name we must load its home
255 -- module so that we find any instance decls lurking therein
256 loadHomeInterface wi_doc name `thenM_`
257 returnM (InTypeEnv ty_thing)
260 -> -- We have slurp something that's already in the type environment,
261 -- that was not slurped in an earlier compilation.
262 -- Must still record it in the Usages info, because that's used to
263 -- generate usage information
265 traceRn (text "not wired in" <+> ppr name) `thenM_`
266 recordUsage (get_main_name ty_thing) `thenM_`
267 returnM (InTypeEnv ty_thing) ;
271 -- STEP 4: OK, we have to slurp it in from an interface file
272 -- First load the interface file
273 traceRn nd_doc `thenM_`
274 loadHomeInterface nd_doc name `thenM_`
276 -- STEP 4: Get the declaration out
277 getEps `thenM` \ eps ->
279 (decls_map, n_slurped) = eps_decls eps
281 case lookupNameEnv decls_map name of
282 Just (avail,_,decl) -> setEps eps' `thenM_`
283 recordUsage (availName avail) `thenM_`
284 returnM (HereItIs decl (mkFVs avail_names))
286 avail_names = availNames avail
287 new_decls_map = foldl delFromNameEnv decls_map avail_names
288 eps' = eps { eps_decls = (new_decls_map, n_slurped+1) }
290 Nothing -> addErr (getDeclErr name) `thenM_`
291 returnM AlreadySlurped
294 wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
295 nd_doc = ptext SLIT("need decl for") <+> ppr name
300 %*********************************************************
302 \subsection{Extracting the `gates'}
304 %*********************************************************
308 We want to avoid sucking in too many instance declarations.
309 An instance decl is only useful if the types and classes mentioned in
310 its 'head' are all available in the program being compiled. E.g.
312 instance (..) => C (T1 a) (T2 b) where ...
314 is only useful if C, T1 and T2 are all "available". So we keep
315 instance decls that have been parsed from .hi files, but not yet
316 slurped in, in a pool called the 'gated instance pool'.
317 Each has its set of 'gates': {C, T1, T2} in the above example.
319 More precisely, the gates of a module are the types and classes
320 that are mentioned in:
322 a) the source code [Note: in fact these don't seem
323 to be treated as gates, perhaps
324 because no imported instance decl
325 can mention them; mutter mutter
327 b) the type of an Id that's mentioned in the source code
328 [includes constructors and selectors]
329 c) the RHS of a type synonym that is a gate
330 d) the superclasses of a class that is a gate
331 e) the context of an instance decl that is slurped in
333 We slurp in an instance decl from the gated instance pool iff
335 all its gates are either in the gates of the module,
336 or the gates of a previously-loaded module
338 The latter constraint is because there might have been an instance
339 decl slurped in during an earlier compilation, like this:
341 instance Foo a => Baz (Maybe a) where ...
343 In the module being compiled we might need (Baz (Maybe T)), where T is
344 defined in this module, and hence we need the instance for (Foo T).
345 So @Foo@ becomes a gate. But there's no way to 'see' that. More
346 generally, types might be involved as well:
348 instance Foo2 S a => Baz2 a where ...
350 Now we must treat S as a gate too, as well as Foo2. So the solution
353 we simply treat the gates of all previously-loaded
354 modules as gates of this one
356 So the gates are remembered across invocations of the renamer in the
357 PersistentRenamerState. This gloss mainly affects ghc --make and ghc
360 (We used to use the persistent type environment for this purpose,
361 but it has too much. For a start, it contains all tuple types,
362 because they are in the wired-in type env!)
365 Consructors and class operations
366 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
367 When we import a declaration like
369 data T = T1 Wibble | T2 Wobble
371 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
372 @T1@, @T2@ respectively are mentioned by the user program. If only
373 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
374 in useless instance decls for (say) @Eq Wibble@, when they can't
377 And that's just what (b) says: we only treat T1's type as a gate if
378 T1 is mentioned. getGates, which deals with decls we are slurping in,
379 has to be a bit careful, because a mention of T1 will slurp in T's whole
382 -----------------------------
383 @getGates@ takes a newly imported (and renamed) decl, and the free
384 vars of the source program, and extracts from the decl the gate names.
387 getGates :: FreeVars -- Things mentioned in the source program
388 -- Used for the cunning "constructors and
389 -- class ops" story described 10 lines above.
393 getGates source_fvs decl
394 = get_gates (\n -> n `elemNameSet` source_fvs) decl
396 get_gates is_used (ForeignType {tcdName = tycon}) = unitNameSet tycon
397 get_gates is_used (IfaceSig {tcdType = ty}) = extractHsTyNames ty
399 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
400 = (super_cls_and_sigs `addOneToNameSet` cls) `unionNameSets`
401 implicitClassGates cls
403 super_cls_and_sigs = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
405 get (ClassOpSig n _ ty _)
406 | is_used n = extractHsTyNames ty
407 | otherwise = emptyFVs
409 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
410 = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
411 -- A type synonym type constructor isn't a "gate" for instance decls
413 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
414 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt)
415 (visibleDataCons cons))
417 `addOneToNameSet` tycon
419 get (ConDecl n tvs ctxt details _)
421 -- If the constructor is method, get fvs from all its fields
422 = delListFromNameSet (get_details details `plusFV`
423 extractHsCtxtTyNames ctxt)
425 get (ConDecl n tvs ctxt (RecCon fields) _)
426 -- Even if the constructor isn't mentioned, the fields
427 -- might be, as selectors. They can't mention existentially
428 -- bound tyvars (typechecker checks for that) so no need for
429 -- the deleteListFromNameSet part
430 = foldr (plusFV . get_field) emptyFVs fields
432 get other_con = emptyFVs
434 get_details (PrefixCon tys) = plusFVs (map get_bang tys)
435 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
436 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
438 get_field (f,t) | is_used f = get_bang t
439 | otherwise = emptyFVs
441 get_bang bty = extractHsTyNames (getBangType bty)
443 implicitClassGates :: Name -> FreeVars
444 implicitClassGates cls
445 -- If we load class Num, add Integer to the free gates
446 -- This takes account of the fact that Integer might be needed for
447 -- defaulting, but we don't want to load Integer (and all its baggage)
448 -- if there's no numeric stuff needed.
449 -- Similarly for class Fractional and Double
451 -- NB: adding T to the gates will force T to be loaded
453 -- NB: If we load (say) Floating, we'll end up loading Fractional too,
454 -- since Fractional is a superclass of Floating
455 | cls `hasKey` numClassKey = unitFV integerTyConName
456 | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
457 | otherwise = emptyFVs
460 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
461 thing rather than a declaration.
464 getWiredInGates :: TyThing -> FreeVars
465 -- The TyThing is one that we already have in our type environment, either
466 -- a) because the TyCon or Id is wired in, or
467 -- b) from a previous compile
469 -- Either way, we might have instance decls in the (persistent) collection
470 -- of parsed-but-not-slurped instance decls that should be slurped in.
471 -- This might be the first module that mentions both the type and the class
472 -- for that instance decl, even though both the type and the class were
473 -- mentioned in other modules, and hence are in the type environment
475 getWiredInGates (AClass cl)
476 = unitFV (getName cl) `plusFV` mkFVs super_classes
478 super_classes = classNamesOfTheta (classSCTheta cl)
480 getWiredInGates (AnId the_id) = tyClsNamesOfType (idType the_id)
481 getWiredInGates (ADataCon dc) = tyClsNamesOfType (idType (dataConWrapId dc))
482 getWiredInGates (ATyCon tc)
483 | isSynTyCon tc = tyClsNamesOfType ty
484 | otherwise = unitFV (getName tc)
486 (_,ty) = getSynTyConDefn tc
488 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
492 getImportedInstDecls :: NameSet -> TcRn m ([(Module,RdrNameInstDecl)], NameSet)
493 -- Returns the gates that are new since last time
494 getImportedInstDecls gates
495 = -- First, load any orphan-instance modules that aren't aready loaded
496 -- Orphan-instance modules are recorded in the module dependecnies
497 getImports `thenM` \ imports ->
498 getEps `thenM` \ eps ->
500 old_gates = eps_inst_gates eps
501 new_gates = gates `minusNameSet` old_gates
502 all_gates = new_gates `unionNameSets` old_gates
503 orphan_mods = imp_orphs imports
505 loadOrphanModules orphan_mods `thenM_`
507 -- Now we're ready to grab the instance declarations
508 -- Find the un-gated ones and return them,
509 -- removing them from the bag kept in EPS
510 -- Don't foget to get the EPS a second time...
511 -- loadOrphanModules may have side-effected it!
512 getEps `thenM` \ eps ->
514 available n = n `elemNameSet` all_gates
515 (decls, new_insts) = selectGated available (eps_insts eps)
517 setEps (eps { eps_insts = new_insts,
518 eps_inst_gates = all_gates }) `thenM_`
520 traceRn (sep [text "getImportedInstDecls:",
521 nest 4 (fsep (map ppr (nameSetToList gates))),
522 nest 4 (fsep (map ppr (nameSetToList all_gates))),
523 nest 4 (fsep (map ppr (nameSetToList new_gates))),
524 text "Slurped" <+> int (length decls) <+> text "instance declarations",
525 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenM_`
526 returnM (decls, new_gates)
528 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
530 HsForAllTy _ _ tau -> ppr tau
533 getImportedRules :: NameSet -- Slurped already
534 -> TcRn m [(Module,RdrNameRuleDecl)]
535 getImportedRules slurped
536 | opt_IgnoreIfacePragmas = returnM []
538 = getEps `thenM` \ eps ->
539 getInGlobalScope `thenM` \ in_type_env ->
540 let -- Slurp rules for anything that is slurped,
541 -- either now, or previously
542 available n = n `elemNameSet` slurped || in_type_env n
543 (decls, new_rules) = selectGated available (eps_rules eps)
548 setEps (eps { eps_rules = new_rules }) `thenM_`
549 traceRn (sep [text "getImportedRules:",
550 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenM_`
553 selectGated :: (Name->Bool) -> GatedDecls d
554 -> ([(Module,d)], GatedDecls d)
555 selectGated available (decl_bag, n_slurped)
556 -- Select only those decls whose gates are *all* available
558 | opt_NoPruneDecls -- Just to try the effect of not gating at all
560 decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag -- Grab them all
562 (decls, (emptyBag, n_slurped + length decls))
566 = case foldrBag select ([], emptyBag) decl_bag of
567 (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
569 select (gate_fn, decl) (yes, no)
570 | gate_fn available = (decl:yes, no)
571 | otherwise = (yes, (gate_fn,decl) `consBag` no)
575 %********************************************************
577 \subsection{Checking usage information}
579 %********************************************************
581 @recompileRequired@ is called from the HscMain. It checks whether
582 a recompilation is required. It needs access to the persistent state,
583 finder, etc, because it may have to load lots of interface files to
584 check their versions.
587 type RecompileRequired = Bool
588 upToDate = False -- Recompile not required
589 outOfDate = True -- Recompile required
591 checkVersions :: Bool -- True <=> source unchanged
592 -> ModIface -- Old interface
593 -> TcRn m RecompileRequired
594 checkVersions source_unchanged iface
595 | not source_unchanged
598 = traceHiDiffs (text "Considering whether compilation is required for" <+>
599 ppr (mi_module iface) <> colon) `thenM_`
601 -- Source code unchanged and no errors yet... carry on
602 -- First put the dependent-module info in the envt, just temporarily,
603 -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
604 -- It's just temporary because either the usage check will succeed
605 -- (in which case we are done with this module) or it'll fail (in which
606 -- case we'll compile the module from scratch anyhow).
607 updGblEnv (\ gbl -> gbl { tcg_imports = mod_deps }) (
608 checkList [checkModUsage u | u <- mi_usages iface]
612 -- This is a bit of a hack really
613 mod_deps = emptyImportAvails { imp_dep_mods = mkModDeps (dep_mods (mi_deps iface)) }
615 checkList :: [TcRn m RecompileRequired] -> TcRn m RecompileRequired
616 checkList [] = returnM upToDate
617 checkList (check:checks) = check `thenM` \ recompile ->
625 checkModUsage :: Usage Name -> TcRn m RecompileRequired
626 -- Given the usage information extracted from the old
627 -- M.hi file for the module being compiled, figure out
628 -- whether M needs to be recompiled.
630 checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
631 usg_rules = old_rule_vers,
632 usg_exports = maybe_old_export_vers,
633 usg_entities = old_decl_vers })
634 = -- Load the imported interface is possible
636 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
638 traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
640 tryM (loadInterface doc_str mod_name ImportBySystem) `thenM` \ mb_iface ->
643 Left exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
645 -- Couldn't find or parse a module mentioned in the
646 -- old interface file. Don't complain -- it might just be that
647 -- the current module doesn't need that import and it's been deleted
651 new_vers = mi_version iface
652 new_mod_vers = vers_module new_vers
653 new_decl_vers = vers_decls new_vers
654 new_export_vers = vers_exports new_vers
655 new_rule_vers = vers_rules new_vers
658 checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
659 if not recompile then
664 if checkExportList maybe_old_export_vers new_export_vers then
665 out_of_date_vers (ptext SLIT(" Export list changed"))
666 (fromJust maybe_old_export_vers)
671 if old_rule_vers /= new_rule_vers then
672 out_of_date_vers (ptext SLIT(" Rules changed"))
673 old_rule_vers new_rule_vers
676 -- CHECK ITEMS ONE BY ONE
677 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenM` \ recompile ->
679 returnM outOfDate -- This one failed, so just bail out now
681 up_to_date (ptext SLIT(" Great! The bits I use are up to date"))
685 ------------------------
686 checkModuleVersion old_mod_vers new_mod_vers
687 | new_mod_vers == old_mod_vers
688 = up_to_date (ptext SLIT("Module version unchanged"))
691 = out_of_date_vers (ptext SLIT(" Module version has changed"))
692 old_mod_vers new_mod_vers
694 ------------------------
695 checkExportList Nothing new_vers = upToDate
696 checkExportList (Just v) new_vers = v /= new_vers
698 ------------------------
699 checkEntityUsage new_vers (name,old_vers)
700 = case lookupNameEnv new_vers name of
702 Nothing -> -- We used it before, but it ain't there now
703 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
705 Just new_vers -- It's there, but is it up to date?
706 | new_vers == old_vers -> traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
708 | otherwise -> out_of_date_vers (ptext SLIT(" Out of date:") <+> ppr name)
711 up_to_date msg = traceHiDiffs msg `thenM_` returnM upToDate
712 out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
713 out_of_date_vers msg old_vers new_vers
714 = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])
718 %*********************************************************
722 %*********************************************************
726 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
727 ptext SLIT("from module") <+> quotes (ppr (nameModule name))