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 )
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 (ADataCon dc) = tyConName (dataConTyCon dc)
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 DataConWorkId 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))
201 GenericOpId tc -> get_main_name (ATyCon tc)
202 ClassOpId cl -> className cl
206 recordUsage :: Name -> TcRn m ()
207 -- Record that the Name has been used, for
208 -- later generation of usage info in the interface file
209 recordUsage name = updUsages (upd_usg name)
212 | isHomeModule mod = addOneToNameSet usages name
215 mod = nameModule name
219 %*********************************************************
221 \subsection{Getting in a declaration}
223 %*********************************************************
226 importDecl :: NameSet -> Name -> TcRn m ImportDeclResult
228 data ImportDeclResult
231 | HereItIs (Module, RdrNameTyClDecl) NameSet
232 -- The NameSet is the bunch of names bound by this decl
234 importDecl already_slurped name
235 = -- STEP 0: Check if it's from this module
236 -- Doing this catches a common case quickly
237 getModule `thenM` \ this_mod ->
238 if nameIsLocalOrFrom this_mod name then
239 -- Variables defined on the GHCi command line (e.g. let x = 3)
240 -- are Internal names (which don't have a Module)
241 returnM AlreadySlurped
244 -- STEP 1: Check if we've slurped it in while compiling this module
245 if name `elemNameSet` already_slurped then
246 returnM AlreadySlurped
249 -- STEP 2: Check if it's already in the type environment
250 tcLookupGlobal_maybe name `thenM` \ maybe_thing ->
251 case maybe_thing of {
255 -> -- When we find a wired-in name we must load its home
256 -- module so that we find any instance decls lurking therein
257 loadHomeInterface wi_doc name `thenM_`
258 returnM (InTypeEnv ty_thing)
261 -> -- We have slurp something that's already in the type environment,
262 -- that was not slurped in an earlier compilation.
263 -- Must still record it in the Usages info, because that's used to
264 -- generate usage information
266 traceRn (text "not wired in" <+> ppr name) `thenM_`
267 recordUsage (get_main_name ty_thing) `thenM_`
268 returnM (InTypeEnv ty_thing) ;
272 -- STEP 4: OK, we have to slurp it in from an interface file
273 -- First load the interface file
274 traceRn nd_doc `thenM_`
275 loadHomeInterface nd_doc name `thenM_`
277 -- STEP 4: Get the declaration out
278 getEps `thenM` \ eps ->
280 (decls_map, n_slurped) = eps_decls eps
282 case lookupNameEnv decls_map name of
283 Just (avail,_,decl) -> setEps eps' `thenM_`
284 recordUsage (availName avail) `thenM_`
285 returnM (HereItIs decl (mkFVs avail_names))
287 avail_names = availNames avail
288 new_decls_map = foldl delFromNameEnv decls_map avail_names
289 eps' = eps { eps_decls = (new_decls_map, n_slurped+1) }
291 Nothing -> addErr (getDeclErr name) `thenM_`
292 returnM AlreadySlurped
295 wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
296 nd_doc = ptext SLIT("need decl for") <+> ppr name
301 %*********************************************************
303 \subsection{Extracting the `gates'}
305 %*********************************************************
309 We want to avoid sucking in too many instance declarations.
310 An instance decl is only useful if the types and classes mentioned in
311 its 'head' are all available in the program being compiled. E.g.
313 instance (..) => C (T1 a) (T2 b) where ...
315 is only useful if C, T1 and T2 are all "available". So we keep
316 instance decls that have been parsed from .hi files, but not yet
317 slurped in, in a pool called the 'gated instance pool'.
318 Each has its set of 'gates': {C, T1, T2} in the above example.
320 More precisely, the gates of a module are the types and classes
321 that are mentioned in:
323 a) the source code [Note: in fact these don't seem
324 to be treated as gates, perhaps
325 because no imported instance decl
326 can mention them; mutter mutter
328 b) the type of an Id that's mentioned in the source code
329 [includes constructors and selectors]
330 c) the RHS of a type synonym that is a gate
331 d) the superclasses of a class that is a gate
332 e) the context of an instance decl that is slurped in
334 We slurp in an instance decl from the gated instance pool iff
336 all its gates are either in the gates of the module,
337 or the gates of a previously-loaded module
339 The latter constraint is because there might have been an instance
340 decl slurped in during an earlier compilation, like this:
342 instance Foo a => Baz (Maybe a) where ...
344 In the module being compiled we might need (Baz (Maybe T)), where T is
345 defined in this module, and hence we need the instance for (Foo T).
346 So @Foo@ becomes a gate. But there's no way to 'see' that. More
347 generally, types might be involved as well:
349 instance Foo2 S a => Baz2 a where ...
351 Now we must treat S as a gate too, as well as Foo2. So the solution
354 we simply treat the gates of all previously-loaded
355 modules as gates of this one
357 So the gates are remembered across invocations of the renamer in the
358 PersistentRenamerState. This gloss mainly affects ghc --make and ghc
361 (We used to use the persistent type environment for this purpose,
362 but it has too much. For a start, it contains all tuple types,
363 because they are in the wired-in type env!)
366 Consructors and class operations
367 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
368 When we import a declaration like
370 data T = T1 Wibble | T2 Wobble
372 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
373 @T1@, @T2@ respectively are mentioned by the user program. If only
374 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
375 in useless instance decls for (say) @Eq Wibble@, when they can't
378 And that's just what (b) says: we only treat T1's type as a gate if
379 T1 is mentioned. getGates, which deals with decls we are slurping in,
380 has to be a bit careful, because a mention of T1 will slurp in T's whole
383 -----------------------------
384 @getGates@ takes a newly imported (and renamed) decl, and the free
385 vars of the source program, and extracts from the decl the gate names.
388 getGates :: FreeVars -- Things mentioned in the source program
389 -- Used for the cunning "constructors and
390 -- class ops" story described 10 lines above.
394 getGates source_fvs decl
395 = get_gates (\n -> n `elemNameSet` source_fvs) decl
397 get_gates is_used (ForeignType {tcdName = tycon}) = unitNameSet tycon
398 get_gates is_used (IfaceSig {tcdType = ty}) = extractHsTyNames ty
400 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
401 = (super_cls_and_sigs `addOneToNameSet` cls) `unionNameSets`
402 implicitClassGates cls
404 super_cls_and_sigs = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
406 get (ClassOpSig n _ ty _)
407 | is_used n = extractHsTyNames ty
408 | otherwise = emptyFVs
410 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
411 = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
412 -- A type synonym type constructor isn't a "gate" for instance decls
414 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
415 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt)
416 (visibleDataCons cons))
418 `addOneToNameSet` tycon
420 get (ConDecl n tvs ctxt details _)
422 -- If the constructor is method, get fvs from all its fields
423 = delListFromNameSet (get_details details `plusFV`
424 extractHsCtxtTyNames ctxt)
426 get (ConDecl n tvs ctxt (RecCon fields) _)
427 -- Even if the constructor isn't mentioned, the fields
428 -- might be, as selectors. They can't mention existentially
429 -- bound tyvars (typechecker checks for that) so no need for
430 -- the deleteListFromNameSet part
431 = foldr (plusFV . get_field) emptyFVs fields
433 get other_con = emptyFVs
435 get_details (PrefixCon tys) = plusFVs (map get_bang tys)
436 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
437 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
439 get_field (f,t) | is_used f = get_bang t
440 | otherwise = emptyFVs
442 get_bang bty = extractHsTyNames (getBangType bty)
444 implicitClassGates :: Name -> FreeVars
445 implicitClassGates cls
446 -- If we load class Num, add Integer to the free gates
447 -- This takes account of the fact that Integer might be needed for
448 -- defaulting, but we don't want to load Integer (and all its baggage)
449 -- if there's no numeric stuff needed.
450 -- Similarly for class Fractional and Double
452 -- NB: adding T to the gates will force T to be loaded
454 -- NB: If we load (say) Floating, we'll end up loading Fractional too,
455 -- since Fractional is a superclass of Floating
456 | cls `hasKey` numClassKey = unitFV integerTyConName
457 | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
458 | otherwise = emptyFVs
461 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
462 thing rather than a declaration.
465 getWiredInGates :: TyThing -> FreeVars
466 -- The TyThing is one that we already have in our type environment, either
467 -- a) because the TyCon or Id is wired in, or
468 -- b) from a previous compile
470 -- Either way, we might have instance decls in the (persistent) collection
471 -- of parsed-but-not-slurped instance decls that should be slurped in.
472 -- This might be the first module that mentions both the type and the class
473 -- for that instance decl, even though both the type and the class were
474 -- mentioned in other modules, and hence are in the type environment
476 getWiredInGates (AClass cl)
477 = unitFV (getName cl) `plusFV` mkFVs super_classes
479 super_classes = classNamesOfTheta (classSCTheta cl)
481 getWiredInGates (AnId the_id) = tyClsNamesOfType (idType the_id)
482 getWiredInGates (ADataCon dc) = tyClsNamesOfType (idType (dataConWrapId dc))
483 -- Should include classes in the 'stupid context' of the data con?
484 getWiredInGates (ATyCon tc)
485 | isSynTyCon tc = tyClsNamesOfType ty
486 | otherwise = unitFV (getName tc)
488 (_,ty) = getSynTyConDefn tc
490 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
494 getImportedInstDecls :: NameSet -> TcRn m ([(Module,RdrNameInstDecl)], NameSet)
495 -- Returns the gates that are new since last time
496 getImportedInstDecls gates
497 = -- First, load any orphan-instance modules that aren't aready loaded
498 -- Orphan-instance modules are recorded in the module dependecnies
499 getImports `thenM` \ imports ->
500 getEps `thenM` \ eps ->
502 old_gates = eps_inst_gates eps
503 new_gates = gates `minusNameSet` old_gates
504 all_gates = new_gates `unionNameSets` old_gates
505 orphan_mods = imp_orphs imports
507 loadOrphanModules orphan_mods `thenM_`
509 -- Now we're ready to grab the instance declarations
510 -- Find the un-gated ones and return them,
511 -- removing them from the bag kept in EPS
512 -- Don't foget to get the EPS a second time...
513 -- loadOrphanModules may have side-effected it!
514 getEps `thenM` \ eps ->
516 available n = n `elemNameSet` all_gates
517 (decls, new_insts) = selectGated available (eps_insts eps)
519 setEps (eps { eps_insts = new_insts,
520 eps_inst_gates = all_gates }) `thenM_`
522 traceRn (sep [text "getImportedInstDecls:",
523 nest 4 (fsep (map ppr (nameSetToList gates))),
524 nest 4 (fsep (map ppr (nameSetToList all_gates))),
525 nest 4 (fsep (map ppr (nameSetToList new_gates))),
526 text "Slurped" <+> int (length decls) <+> text "instance declarations",
527 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenM_`
528 returnM (decls, new_gates)
530 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
532 HsForAllTy _ _ tau -> ppr tau
535 getImportedRules :: NameSet -- Slurped already
536 -> TcRn m [(Module,RdrNameRuleDecl)]
537 getImportedRules slurped
538 | opt_IgnoreIfacePragmas = returnM []
540 = getEps `thenM` \ eps ->
541 getInGlobalScope `thenM` \ in_type_env ->
542 let -- Slurp rules for anything that is slurped,
543 -- either now, or previously
544 available n = n `elemNameSet` slurped || in_type_env n
545 (decls, new_rules) = selectGated available (eps_rules eps)
550 setEps (eps { eps_rules = new_rules }) `thenM_`
551 traceRn (sep [text "getImportedRules:",
552 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenM_`
555 selectGated :: (Name->Bool) -> GatedDecls d
556 -> ([(Module,d)], GatedDecls d)
557 selectGated available (decl_bag, n_slurped)
558 -- Select only those decls whose gates are *all* available
560 | opt_NoPruneDecls -- Just to try the effect of not gating at all
562 decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag -- Grab them all
564 (decls, (emptyBag, n_slurped + length decls))
568 = case foldrBag select ([], emptyBag) decl_bag of
569 (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
571 select (gate_fn, decl) (yes, no)
572 | gate_fn available = (decl:yes, no)
573 | otherwise = (yes, (gate_fn,decl) `consBag` no)
577 %********************************************************
579 \subsection{Checking usage information}
581 %********************************************************
583 @recompileRequired@ is called from the HscMain. It checks whether
584 a recompilation is required. It needs access to the persistent state,
585 finder, etc, because it may have to load lots of interface files to
586 check their versions.
589 type RecompileRequired = Bool
590 upToDate = False -- Recompile not required
591 outOfDate = True -- Recompile required
593 checkVersions :: Bool -- True <=> source unchanged
594 -> ModIface -- Old interface
595 -> TcRn m RecompileRequired
596 checkVersions source_unchanged iface
597 | not source_unchanged
600 = traceHiDiffs (text "Considering whether compilation is required for" <+>
601 ppr (mi_module iface) <> colon) `thenM_`
603 -- Source code unchanged and no errors yet... carry on
604 -- First put the dependent-module info in the envt, just temporarily,
605 -- so that when we look for interfaces we look for the right one (.hi or .hi-boot)
606 -- It's just temporary because either the usage check will succeed
607 -- (in which case we are done with this module) or it'll fail (in which
608 -- case we'll compile the module from scratch anyhow).
609 updGblEnv (\ gbl -> gbl { tcg_imports = mod_deps }) (
610 checkList [checkModUsage u | u <- mi_usages iface]
614 -- This is a bit of a hack really
615 mod_deps = emptyImportAvails { imp_dep_mods = mkModDeps (dep_mods (mi_deps iface)) }
617 checkList :: [TcRn m RecompileRequired] -> TcRn m RecompileRequired
618 checkList [] = returnM upToDate
619 checkList (check:checks) = check `thenM` \ recompile ->
627 checkModUsage :: Usage Name -> TcRn m RecompileRequired
628 -- Given the usage information extracted from the old
629 -- M.hi file for the module being compiled, figure out
630 -- whether M needs to be recompiled.
632 checkModUsage (Usage { usg_name = mod_name, usg_mod = old_mod_vers,
633 usg_rules = old_rule_vers,
634 usg_exports = maybe_old_export_vers,
635 usg_entities = old_decl_vers })
636 = -- Load the imported interface is possible
638 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
640 traceHiDiffs (text "Checking usages for module" <+> ppr mod_name) `thenM_`
642 tryM (loadInterface doc_str mod_name ImportBySystem) `thenM` \ mb_iface ->
645 Left exn -> (out_of_date (sep [ptext SLIT("Can't find version number for module"),
647 -- Couldn't find or parse a module mentioned in the
648 -- old interface file. Don't complain -- it might just be that
649 -- the current module doesn't need that import and it's been deleted
653 new_vers = mi_version iface
654 new_mod_vers = vers_module new_vers
655 new_decl_vers = vers_decls new_vers
656 new_export_vers = vers_exports new_vers
657 new_rule_vers = vers_rules new_vers
660 checkModuleVersion old_mod_vers new_mod_vers `thenM` \ recompile ->
661 if not recompile then
666 if checkExportList maybe_old_export_vers new_export_vers then
667 out_of_date_vers (ptext SLIT(" Export list changed"))
668 (fromJust maybe_old_export_vers)
673 if old_rule_vers /= new_rule_vers then
674 out_of_date_vers (ptext SLIT(" Rules changed"))
675 old_rule_vers new_rule_vers
678 -- CHECK ITEMS ONE BY ONE
679 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenM` \ recompile ->
681 returnM outOfDate -- This one failed, so just bail out now
683 up_to_date (ptext SLIT(" Great! The bits I use are up to date"))
687 ------------------------
688 checkModuleVersion old_mod_vers new_mod_vers
689 | new_mod_vers == old_mod_vers
690 = up_to_date (ptext SLIT("Module version unchanged"))
693 = out_of_date_vers (ptext SLIT(" Module version has changed"))
694 old_mod_vers new_mod_vers
696 ------------------------
697 checkExportList Nothing new_vers = upToDate
698 checkExportList (Just v) new_vers = v /= new_vers
700 ------------------------
701 checkEntityUsage new_vers (name,old_vers)
702 = case lookupNameEnv new_vers name of
704 Nothing -> -- We used it before, but it ain't there now
705 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
707 Just new_vers -- It's there, but is it up to date?
708 | new_vers == old_vers -> traceHiDiffs (text " Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenM_`
710 | otherwise -> out_of_date_vers (ptext SLIT(" Out of date:") <+> ppr name)
713 up_to_date msg = traceHiDiffs msg `thenM_` returnM upToDate
714 out_of_date msg = traceHiDiffs msg `thenM_` returnM outOfDate
715 out_of_date_vers msg old_vers new_vers
716 = out_of_date (hsep [msg, ppr old_vers, ptext SLIT("->"), ppr new_vers])
720 %*********************************************************
724 %*********************************************************
728 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
729 ptext SLIT("from module") <+> quotes (ppr (nameModule name))