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 RnSource ( rnTyClDecl, rnInstDecl, rnIfaceRuleDecl )
27 import TcEnv ( getInGlobalScope, tcLookupGlobal_maybe )
29 import Id ( idType, idName, globalIdDetails )
30 import IdInfo ( GlobalIdDetails(..) )
31 import TcType ( tyClsNamesOfType, classNamesOfTheta )
32 import FieldLabel ( fieldLabelTyCon )
33 import DataCon ( dataConTyCon )
34 import TyCon ( visibleDataCons, isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
35 import Class ( className, classSCTheta )
36 import Name ( Name {-instance NamedThing-}, isWiredInName, isInternalName, nameModule, NamedThing(..)
38 import NameEnv ( delFromNameEnv, lookupNameEnv )
40 import Module ( Module, isHomeModule, extendModuleSet )
41 import PrelInfo ( hasKey, fractionalClassKey, numClassKey,
42 integerTyConName, doubleTyConName )
46 import Maybe( fromJust )
50 %*********************************************************
52 \subsection{Slurping declarations}
54 %*********************************************************
57 -------------------------------------------------------
58 slurpImpDecls :: FreeVars -> TcRn m [RenamedHsDecl]
59 slurpImpDecls source_fvs
60 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenM_`
62 -- Slurp in things which might be 'gates' for instance
63 -- declarations, plus the instance declarations themselves
64 slurpSourceRefs source_fvs `thenM` \ (gate_decls, bndrs) ->
66 -- Then get everything else
68 needed = foldr (plusFV . impDeclFVs) emptyFVs gate_decls
70 import_supporting_decls (gate_decls, bndrs) needed
73 -------------------------------------------------------
74 slurpSourceRefs :: FreeVars -- Variables referenced in source
75 -> TcRn m ([RenamedHsDecl], -- Needed declarations
76 NameSet) -- Names bound by those declarations
77 -- Slurp imported declarations needed directly by the source code;
78 -- and some of the ones they need. The goal is to find all the 'gates'
79 -- for instance declarations.
81 slurpSourceRefs source_fvs
82 = go_outer [] emptyFVs -- Accumulating decls
83 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
85 -- The outer loop repeatedly slurps the decls for the current gates
86 -- and the instance decls
88 -- The outer loop is needed because consider
89 -- instance Foo a => Baz (Maybe a) where ...
90 -- It may be that Baz and Maybe are used in the source module,
91 -- but not Foo; so we need to chase Foo too.
93 -- We also need to follow superclass refs. In particular, 'chasing Foo' must
94 -- include actually getting in Foo's class decl
95 -- class Wib a => Foo a where ..
96 -- so that its superclasses are discovered. The point is that Wib is a gate too.
97 -- We do this for tycons too, so that we look through type synonyms.
99 go_outer decls bndrs [] = returnM (decls, bndrs)
101 go_outer decls bndrs refs -- 'refs' are not necessarily slurped yet
102 = traceRn (text "go_outer" <+> ppr refs) `thenM_`
103 foldlM go_inner (decls, bndrs, emptyFVs) refs `thenM` \ (decls1, bndrs1, gates1) ->
104 getImportedInstDecls gates1 `thenM` \ (inst_decls, new_gates) ->
105 rnIfaceDecls rnInstDecl inst_decls `thenM` \ inst_decls' ->
106 go_outer (map InstD inst_decls' ++ decls1)
108 (nameSetToList (new_gates `plusFV` plusFVs (map getInstDeclGates inst_decls')))
109 -- NB: we go round again to fetch the decls for any gates of any decls
110 -- we have loaded. For example, if we mention
111 -- print :: Show a => a -> String
112 -- then we must load the decl for Show before stopping, to ensure
113 -- that instances from its home module are available
115 go_inner (decls, bndrs, gates) wanted_name
116 = importDecl bndrs wanted_name `thenM` \ import_result ->
117 case import_result of
118 AlreadySlurped -> returnM (decls, bndrs, gates)
122 bndrs `addOneFV` wanted_name, -- Avoid repeated calls to getWiredInGates
123 gates `plusFV` getWiredInGates ty_thing)
125 HereItIs decl new_bndrs
126 -> rnIfaceDecl rnTyClDecl decl `thenM` \ new_decl ->
127 returnM (TyClD new_decl : decls,
128 bndrs `plusFV` new_bndrs,
129 gates `plusFV` getGates source_fvs new_decl)
133 -------------------------------------------------------
134 -- import_supporting_decls keeps going until the free-var set is empty
135 importSupportingDecls needed
136 = import_supporting_decls ([], emptyNameSet) needed
138 import_supporting_decls
139 :: ([RenamedHsDecl], NameSet) -- Some imported decls, with their binders
140 -> FreeVars -- Remaining un-slurped names
141 -> TcRn m [RenamedHsDecl]
142 import_supporting_decls decls needed
143 = slurpIfaceDecls decls needed `thenM` \ (decls1, bndrs1) ->
144 getImportedRules bndrs1 `thenM` \ rule_decls ->
146 [] -> returnM decls1 -- No new rules, so we are done
147 other -> rnIfaceDecls rnIfaceRuleDecl rule_decls `thenM` \ rule_decls' ->
149 rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
150 decls2 = decls1 ++ map RuleD rule_decls'
152 traceRn (text "closeRules" <+> ppr rule_decls' $$
153 fsep (map ppr (nameSetToList rule_fvs))) `thenM_`
154 import_supporting_decls (decls2, bndrs1) rule_fvs
157 -------------------------------------------------------
158 -- Augment decls with any decls needed by needed,
159 -- and so on transitively
160 slurpIfaceDecls :: ([RenamedHsDecl], NameSet) -- Already slurped
161 -> FreeVars -- Still needed
162 -> TcRn m ([RenamedHsDecl], NameSet)
163 slurpIfaceDecls (decls, bndrs) needed
164 = slurp decls bndrs (nameSetToList needed)
166 slurp decls bndrs [] = returnM (decls, bndrs)
167 slurp decls bndrs (n:ns)
168 = importDecl bndrs n `thenM` \ import_result ->
169 case import_result of
170 HereItIs decl new_bndrs -- Found a declaration... rename it
171 -> rnIfaceDecl rnTyClDecl decl `thenM` \ new_decl ->
172 slurp (TyClD new_decl : decls)
173 (bndrs `plusFV` new_bndrs)
174 (nameSetToList (tyClDeclFVs new_decl) ++ ns)
177 other -> -- No declaration... (wired in thing, or deferred,
178 -- or already slurped)
179 slurp decls (bndrs `addOneFV` n) ns
181 -------------------------------------------------------
182 rnIfaceDecls rn decls = mappM (rnIfaceDecl rn) decls
183 rnIfaceDecl rn (mod, decl) = initRn (InterfaceMode mod) (rn decl)
188 -- Tiresomely, we must get the "main" name for the
189 -- thing, because that's what VSlurp contains, and what
190 -- is recorded in the usage information
191 get_main_name (AClass cl) = className cl
192 get_main_name (ATyCon tc)
193 | Just clas <- tyConClass_maybe tc = get_main_name (AClass clas)
194 | otherwise = tyConName tc
195 get_main_name (AnId id)
196 = case globalIdDetails id of
197 DataConId dc -> get_main_name (ATyCon (dataConTyCon dc))
198 DataConWrapId dc -> get_main_name (ATyCon (dataConTyCon dc))
199 RecordSelId lbl -> get_main_name (ATyCon (fieldLabelTyCon lbl))
203 recordUsage :: Name -> TcRn m ()
204 -- Record that the Name has been used, for
205 -- later generation of usage info in the interface file
206 recordUsage name = updUsages (upd_usg name)
209 | isHomeModule mod = usages { usg_home = addOneToNameSet (usg_home usages) name }
210 | otherwise = usages { usg_ext = extendModuleSet (usg_ext usages) mod }
212 mod = nameModule name
216 %*********************************************************
218 \subsection{Getting in a declaration}
220 %*********************************************************
223 importDecl :: NameSet -> Name -> TcRn m ImportDeclResult
225 data ImportDeclResult
228 | HereItIs (Module, RdrNameTyClDecl) NameSet
229 -- The NameSet is the bunch of names bound by this decl
231 importDecl already_slurped name
232 = -- STEP 0: Check if it's from this module
233 -- Doing this catches a common case quickly
234 getModule `thenM` \ this_mod ->
235 if isInternalName name || nameModule name == this_mod then
236 -- Variables defined on the GHCi command line (e.g. let x = 3)
237 -- are Internal names (which don't have a Module)
238 returnM AlreadySlurped
241 -- STEP 1: Check if we've slurped it in while compiling this module
242 if name `elemNameSet` already_slurped then
243 returnM AlreadySlurped
246 -- STEP 2: Check if it's already in the type environment
247 tcLookupGlobal_maybe name `thenM` \ maybe_thing ->
248 case maybe_thing of {
252 -> -- When we find a wired-in name we must load its home
253 -- module so that we find any instance decls lurking therein
254 loadHomeInterface wi_doc name `thenM_`
255 returnM (InTypeEnv ty_thing)
258 -> -- We have slurp something that's already in the type environment,
259 -- that was not slurped in an earlier compilation.
260 -- Must still record it in the Usages info, because that's used to
261 -- generate usage information
263 traceRn (text "not wired in" <+> ppr name) `thenM_`
264 recordUsage (get_main_name ty_thing) `thenM_`
265 returnM (InTypeEnv ty_thing) ;
269 -- STEP 4: OK, we have to slurp it in from an interface file
270 -- First load the interface file
271 traceRn nd_doc `thenM_`
272 loadHomeInterface nd_doc name `thenM_`
274 -- STEP 4: Get the declaration out
275 getEps `thenM` \ eps ->
277 (decls_map, n_slurped) = eps_decls eps
279 case lookupNameEnv decls_map name of
280 Just (avail,_,decl) -> setEps eps' `thenM_`
281 recordUsage (availName avail) `thenM_`
282 returnM (HereItIs decl (mkFVs avail_names))
284 avail_names = availNames avail
285 new_decls_map = foldl delFromNameEnv decls_map avail_names
286 eps' = eps { eps_decls = (new_decls_map, n_slurped+1) }
288 Nothing -> addErr (getDeclErr name) `thenM_`
289 returnM AlreadySlurped
292 wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
293 nd_doc = ptext SLIT("need decl for") <+> ppr name
298 %*********************************************************
300 \subsection{Extracting the `gates'}
302 %*********************************************************
306 We want to avoid sucking in too many instance declarations.
307 An instance decl is only useful if the types and classes mentioned in
308 its 'head' are all available in the program being compiled. E.g.
310 instance (..) => C (T1 a) (T2 b) where ...
312 is only useful if C, T1 and T2 are all "available". So we keep
313 instance decls that have been parsed from .hi files, but not yet
314 slurped in, in a pool called the 'gated instance pool'.
315 Each has its set of 'gates': {C, T1, T2} in the above example.
317 More precisely, the gates of a module are the types and classes
318 that are mentioned in:
320 a) the source code [Note: in fact these don't seem
321 to be treated as gates, perhaps
322 because no imported instance decl
323 can mention them; mutter mutter
325 b) the type of an Id that's mentioned in the source code
326 [includes constructors and selectors]
327 c) the RHS of a type synonym that is a gate
328 d) the superclasses of a class that is a gate
329 e) the context of an instance decl that is slurped in
331 We slurp in an instance decl from the gated instance pool iff
333 all its gates are either in the gates of the module,
334 or the gates of a previously-loaded module
336 The latter constraint is because there might have been an instance
337 decl slurped in during an earlier compilation, like this:
339 instance Foo a => Baz (Maybe a) where ...
341 In the module being compiled we might need (Baz (Maybe T)), where T is
342 defined in this module, and hence we need the instance for (Foo T).
343 So @Foo@ becomes a gate. But there's no way to 'see' that. More
344 generally, types might be involved as well:
346 instance Foo2 S a => Baz2 a where ...
348 Now we must treat S as a gate too, as well as Foo2. So the solution
351 we simply treat the gates of all previously-loaded
352 modules as gates of this one
354 So the gates are remembered across invocations of the renamer in the
355 PersistentRenamerState. This gloss mainly affects ghc --make and ghc
358 (We used to use the persistent type environment for this purpose,
359 but it has too much. For a start, it contains all tuple types,
360 because they are in the wired-in type env!)
363 Consructors and class operations
364 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
365 When we import a declaration like
367 data T = T1 Wibble | T2 Wobble
369 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
370 @T1@, @T2@ respectively are mentioned by the user program. If only
371 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
372 in useless instance decls for (say) @Eq Wibble@, when they can't
375 And that's just what (b) says: we only treat T1's type as a gate if
376 T1 is mentioned. getGates, which deals with decls we are slurping in,
377 has to be a bit careful, because a mention of T1 will slurp in T's whole
380 -----------------------------
381 @getGates@ takes a newly imported (and renamed) decl, and the free
382 vars of the source program, and extracts from the decl the gate names.
385 getGates :: FreeVars -- Things mentioned in the source program
386 -- Used for the cunning "constructors and
387 -- class ops" story described 10 lines above.
391 getGates source_fvs decl
392 = get_gates (\n -> n `elemNameSet` source_fvs) decl
394 get_gates is_used (ForeignType {tcdName = tycon}) = unitNameSet tycon
395 get_gates is_used (IfaceSig {tcdType = ty}) = extractHsTyNames ty
397 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
398 = (super_cls_and_sigs `addOneToNameSet` cls) `unionNameSets`
399 implicitClassGates cls
401 super_cls_and_sigs = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
403 get (ClassOpSig n _ ty _)
404 | is_used n = extractHsTyNames ty
405 | otherwise = emptyFVs
407 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
408 = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
409 -- A type synonym type constructor isn't a "gate" for instance decls
411 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
412 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt)
413 (visibleDataCons cons))
415 `addOneToNameSet` tycon
417 get (ConDecl n tvs ctxt details _)
419 -- If the constructor is method, get fvs from all its fields
420 = delListFromNameSet (get_details details `plusFV`
421 extractHsCtxtTyNames ctxt)
423 get (ConDecl n tvs ctxt (RecCon fields) _)
424 -- Even if the constructor isn't mentioned, the fields
425 -- might be, as selectors. They can't mention existentially
426 -- bound tyvars (typechecker checks for that) so no need for
427 -- the deleteListFromNameSet part
428 = foldr (plusFV . get_field) emptyFVs fields
430 get other_con = emptyFVs
432 get_details (PrefixCon tys) = plusFVs (map get_bang tys)
433 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
434 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
436 get_field (f,t) | is_used f = get_bang t
437 | otherwise = emptyFVs
439 get_bang bty = extractHsTyNames (getBangType bty)
441 implicitClassGates :: Name -> FreeVars
442 implicitClassGates cls
443 -- If we load class Num, add Integer to the free gates
444 -- This takes account of the fact that Integer might be needed for
445 -- defaulting, but we don't want to load Integer (and all its baggage)
446 -- if there's no numeric stuff needed.
447 -- Similarly for class Fractional and Double
449 -- NB: adding T to the gates will force T to be loaded
451 -- NB: If we load (say) Floating, we'll end up loading Fractional too,
452 -- since Fractional is a superclass of Floating
453 | cls `hasKey` numClassKey = unitFV integerTyConName
454 | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
455 | otherwise = emptyFVs
458 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
459 thing rather than a declaration.
462 getWiredInGates :: TyThing -> FreeVars
463 -- The TyThing is one that we already have in our type environment, either
464 -- a) because the TyCon or Id is wired in, or
465 -- b) from a previous compile
467 -- Either way, we might have instance decls in the (persistent) collection
468 -- of parsed-but-not-slurped instance decls that should be slurped in.
469 -- This might be the first module that mentions both the type and the class
470 -- for that instance decl, even though both the type and the class were
471 -- mentioned in other modules, and hence are in the type environment
473 getWiredInGates (AClass cl)
474 = unitFV (getName cl) `plusFV` mkFVs super_classes
476 super_classes = classNamesOfTheta (classSCTheta cl)
478 getWiredInGates (AnId the_id) = tyClsNamesOfType (idType the_id)
479 getWiredInGates (ATyCon tc)
480 | isSynTyCon tc = tyClsNamesOfType ty
481 | otherwise = unitFV (getName tc)
483 (_,ty) = getSynTyConDefn tc
485 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
489 getImportedInstDecls :: NameSet -> TcRn m ([(Module,RdrNameInstDecl)], NameSet)
490 -- Returns the gates that are new since last time
491 getImportedInstDecls gates
492 = -- First, load any orphan-instance modules that aren't aready loaded
493 -- Orphan-instance modules are recorded in the module dependecnies
494 getEps `thenM` \ eps ->
496 old_gates = eps_inst_gates eps
497 new_gates = gates `minusNameSet` old_gates
498 all_gates = new_gates `unionNameSets` old_gates
499 orphan_mods = [mod | (mod, (True, _)) <- fmToList (eps_imp_mods eps)]
501 loadOrphanModules orphan_mods `thenM_`
503 -- Now we're ready to grab the instance declarations
504 -- Find the un-gated ones and return them,
505 -- removing them from the bag kept in EPS
506 -- Don't foget to get the EPS a second time...
507 -- loadOrphanModules may have side-effected it!
508 getEps `thenM` \ eps ->
510 available n = n `elemNameSet` all_gates
511 (decls, new_insts) = selectGated available (eps_insts eps)
513 setEps (eps { eps_insts = new_insts,
514 eps_inst_gates = all_gates }) `thenM_`
516 traceRn (sep [text "getImportedInstDecls:",
517 nest 4 (fsep (map ppr (nameSetToList gates))),
518 nest 4 (fsep (map ppr (nameSetToList all_gates))),
519 nest 4 (fsep (map ppr (nameSetToList new_gates))),
520 text "Slurped" <+> int (length decls) <+> text "instance declarations",
521 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenM_`
522 returnM (decls, new_gates)
524 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
526 HsForAllTy _ _ tau -> ppr tau
529 getImportedRules :: NameSet -- Slurped already
530 -> TcRn m [(Module,RdrNameRuleDecl)]
531 getImportedRules slurped
532 | opt_IgnoreIfacePragmas = returnM []
534 = getEps `thenM` \ eps ->
535 getInGlobalScope `thenM` \ in_type_env ->
537 -- Slurp rules for anything that is slurped,
538 -- either now, or previously
539 available n = n `elemNameSet` slurped || in_type_env n
540 (decls, new_rules) = selectGated available (eps_rules eps)
545 setEps (eps { eps_rules = new_rules }) `thenM_`
546 traceRn (sep [text "getImportedRules:",
547 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenM_`
550 selectGated :: (Name->Bool) -> GatedDecls d
551 -> ([(Module,d)], GatedDecls d)
552 selectGated available (decl_bag, n_slurped)
553 -- Select only those decls whose gates are *all* available
555 | opt_NoPruneDecls -- Just to try the effect of not gating at all
557 decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag -- Grab them all
559 (decls, (emptyBag, n_slurped + length decls))
563 = case foldrBag select ([], emptyBag) decl_bag of
564 (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
566 select (gate_fn, decl) (yes, no)
567 | gate_fn available = (decl:yes, no)
568 | otherwise = (yes, (gate_fn,decl) `consBag` no)
572 %********************************************************
574 \subsection{Checking usage information}
576 %********************************************************
578 @recompileRequired@ is called from the HscMain. It checks whether
579 a recompilation is required. It needs access to the persistent state,
580 finder, etc, because it may have to load lots of interface files to
581 check their versions.
584 type RecompileRequired = Bool
585 upToDate = False -- Recompile not required
586 outOfDate = True -- Recompile required
588 checkVersions :: Bool -- True <=> source unchanged
589 -> ModIface -- Old interface
590 -> TcRn m RecompileRequired
591 checkVersions source_unchanged iface
592 | not source_unchanged
595 = traceHiDiffs (text "Considering whether compilation is required for" <+>
596 ppr (mi_module iface) <> colon) `thenM_`
598 -- Source code unchanged and no errors yet... carry on
599 checkList [checkModUsage u | u <- mi_usages iface]
601 checkList :: [TcRn m RecompileRequired] -> TcRn m RecompileRequired
602 checkList [] = returnM upToDate
603 checkList (check:checks) = check `thenM` \ recompile ->
611 checkModUsage :: ImportVersion Name -> TcRn m RecompileRequired
612 -- Given the usage information extracted from the old
613 -- M.hi file for the module being compiled, figure out
614 -- whether M needs to be recompiled.
616 checkModUsage (mod_name, _, _, NothingAtAll)
617 -- If CurrentModule.hi contains
619 -- then that simply records that Foo lies below CurrentModule in the
620 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
621 -- In this case we don't even want to open Foo's interface.
622 = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
624 checkModUsage (mod_name, _, is_boot, whats_imported)
625 = -- Load the imported interface is possible
626 -- We use tryLoadInterface, because failure is not an error
627 -- (might just be that the old .hi file for this module is out of date)
629 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
630 from = ImportForUsage is_boot
632 traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
634 recoverM (returnM Nothing)
635 (loadInterface doc_str mod_name from `thenM` \ iface ->
636 returnM (Just iface)) `thenM` \ mb_iface ->
639 Nothing -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
641 -- Couldn't find or parse a module mentioned in the
642 -- old interface file. Don't complain -- it might just be that
643 -- the current module doesn't need that import and it's been deleted
647 new_vers = mi_version iface
648 new_mod_vers = vers_module new_vers
649 new_decl_vers = vers_decls new_vers
650 new_export_vers = vers_exports new_vers
651 new_rule_vers = vers_rules new_vers
653 case whats_imported of { -- NothingAtAll dealt with earlier
655 Everything old_mod_vers -> checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
657 out_of_date (ptext SLIT("...and I needed the whole module"))
661 Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
664 checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
665 if not recompile then
670 if checkExportList maybe_old_export_vers new_export_vers then
671 out_of_date_vers (ptext SLIT(" Export list changed"))
672 (fromJust maybe_old_export_vers)
677 if old_rule_vers /= new_rule_vers then
678 out_of_date_vers (ptext SLIT(" Rules changed"))
679 old_rule_vers new_rule_vers
682 -- CHECK ITEMS ONE BY ONE
683 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenM` \ recompile ->
685 returnM outOfDate -- This one failed, so just bail out now
687 up_to_date (ptext SLIT(" Great! The bits I use are up to date"))
691 ------------------------
692 checkModuleVersion old_mod_vers new_mod_vers
693 | new_mod_vers == old_mod_vers
694 = up_to_date (ptext SLIT("Module version unchanged"))
697 = out_of_date_vers (ptext SLIT(" Module version has changed"))
698 old_mod_vers new_mod_vers
700 ------------------------
701 checkExportList Nothing new_vers = upToDate
702 checkExportList (Just v) new_vers = v /= new_vers
704 ------------------------
705 checkEntityUsage new_vers (name,old_vers)
706 = case lookupNameEnv new_vers name of
708 Nothing -> -- We used it before, but it ain't there now
709 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
711 Just new_vers -- It's there, but is it up to date?
712 | new_vers == old_vers -> traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
714 | otherwise -> out_of_date_vers (ptext SLIT(" Out of date:") <+> ppr name)
717 up_to_date msg = traceHiDiffs msg `thenM_` returnM upToDate
718 out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
719 out_of_date_vers msg old_vers new_vers
720 = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])
724 %*********************************************************
728 %*********************************************************
732 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
733 ptext SLIT("from module") <+> quotes (ppr (nameModule name))