2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
12 slurpImpDecls, closeDecls,
14 RecompileRequired, outOfDate, upToDate, recompileRequired
18 #include "HsVersions.h"
20 import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_NoPruneDecls )
22 import HsSyn ( HsDecl(..), Sig(..), TyClDecl(..), ConDecl(..), ConDetails(..),
23 InstDecl(..), HsType(..), hsTyVarNames, getBangType
25 import HsImpExp ( ImportDecl(..) )
26 import RdrHsSyn ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
27 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl,
28 extractHsTyNames, extractHsCtxtTyNames,
29 tyClDeclFVs, ruleDeclFVs, instDeclFVs
31 import RnHiFiles ( tryLoadInterface, loadHomeInterface,
34 import RnSource ( rnTyClDecl, rnInstDecl, rnIfaceRuleDecl )
38 import Type ( namesOfType )
39 import TyCon ( isSynTyCon, getSynTyConDefn )
40 import Name ( Name {-instance NamedThing-}, nameOccName,
41 nameModule, isLocalName, isHomePackageName,
44 import Name ( elemNameEnv, delFromNameEnv )
45 import Module ( Module, ModuleEnv,
46 moduleName, isHomeModule,
47 ModuleName, WhereFrom(..),
49 extendModuleEnv_C, foldModuleEnv, lookupModuleEnv,
50 elemModuleSet, extendModuleSet
53 import PrelInfo ( wiredInThingEnv )
54 import Maybes ( orElse )
58 import Util ( sortLt )
62 %*********************************************************
64 \subsection{Keeping track of what we've slurped, and version numbers}
66 %*********************************************************
68 mkImportInof figures out what the ``usage information'' for this
69 moudule is; that is, what it must record in its interface file as the
72 We produce a line for every module B below the module, A, currently being
75 to record the fact that A does import B indireclty. This is used to decide
76 to look to look for B.hi rather than B.hi-boot when compiling a module that
77 imports A. This line says that A imports B, but uses nothing in it.
78 So we'll get an early bale-out when compiling A if B's version changes.
81 mkImportInfo :: ModuleName -- Name of this module
82 -> [ImportDecl n] -- The import decls
83 -> RnMG [ImportVersion Name]
85 mkImportInfo this_mod imports
86 = getIfacesRn `thenRn` \ ifaces ->
87 getHomeIfaceTableRn `thenRn` \ hit ->
89 (imp_pkg_mods, imp_home_names) = iVSlurp ifaces
92 import_all_mods :: [ModuleName]
93 -- Modules where we imported all the names
94 -- (apart from hiding some, perhaps)
95 import_all_mods = [ m | ImportDecl m _ _ _ imp_list _ <- imports,
98 import_all (Just (False, _)) = False -- Imports are specified explicitly
99 import_all other = True -- Everything is imported
101 -- mv_map groups together all the things imported and used
102 -- from a particular module in this package
103 -- We use a finite map because we want the domain
104 mv_map :: ModuleEnv [Name]
105 mv_map = foldNameSet add_mv emptyModuleEnv imp_home_names
106 add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
108 mod = nameModule name
109 add_item names _ = name:names
111 -- In our usage list we record
112 -- a) Specifically: Detailed version info for imports from modules in this package
113 -- Gotten from iVSlurp plus import_all_mods
115 -- b) Everything: Just the module version for imports from modules in other packages
116 -- Gotten from iVSlurp plus import_all_mods
118 -- c) NothingAtAll: The name only of modules, Baz, in this package that are 'below' us,
119 -- but which we didn't need at all (this is needed only to decide whether
120 -- to open Baz.hi or Baz.hi-boot higher up the tree).
121 -- This happens when a module, Foo, that we explicitly imported has
122 -- 'import Baz' in its interface file, recording that Baz is below
123 -- Foo in the module dependency hierarchy. We want to propagate this info.
124 -- These modules are in a combination of HIT/PIT and iImpModInfo
126 -- d) NothingAtAll: The name only of all orphan modules we know of (this is needed
127 -- so that anyone who imports us can find the orphan modules)
128 -- These modules are in a combination of HIT/PIT and iImpModInfo
130 import_info0 = foldModuleEnv mk_imp_info [] pit
131 import_info1 = foldModuleEnv mk_imp_info import_info0 hit
132 import_info = [ (mod_name, orphans, is_boot, NothingAtAll)
133 | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ] ++
136 mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
137 mk_imp_info iface so_far
139 | Just ns <- lookupModuleEnv mv_map mod -- Case (a)
140 = go_for_it (Specifically mod_vers maybe_export_vers
141 (mk_import_items ns) rules_vers)
143 | mod `elemModuleSet` imp_pkg_mods -- Case (b)
144 = go_for_it (Everything mod_vers)
146 | import_all_mod -- Case (a) and (b); the import-all part
147 = if is_home_pkg_mod then
148 go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
150 go_for_it (Everything mod_vers)
152 | is_home_pkg_mod || has_orphans -- Case (c) or (d)
153 = go_for_it NothingAtAll
157 go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
159 mod = mi_module iface
160 mod_name = moduleName mod
161 is_home_pkg_mod = isHomeModule mod
162 version_info = mi_version iface
163 version_env = vers_decls version_info
164 mod_vers = vers_module version_info
165 rules_vers = vers_rules version_info
166 export_vers = vers_exports version_info
167 import_all_mod = mod_name `elem` import_all_mods
168 has_orphans = mi_orphan iface
170 -- The sort is to put them into canonical order
171 mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
172 let v = lookupNameEnv version_env n `orElse`
173 pprPanic "mk_whats_imported" (ppr n)
176 lt_occ n1 n2 = nameOccName n1 < nameOccName n2
178 maybe_export_vers | import_all_mod = Just (vers_exports version_info)
179 | otherwise = Nothing
184 %*********************************************************
186 \subsection{Slurping declarations}
188 %*********************************************************
191 -------------------------------------------------------
192 slurpImpDecls source_fvs
193 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
195 -- The current slurped-set records all local things
196 slurpSourceRefs source_fvs `thenRn` \ (decls, needed) ->
198 -- Then get everything else
199 closeDecls decls needed
202 -------------------------------------------------------
203 slurpSourceRefs :: FreeVars -- Variables referenced in source
204 -> RnMG ([RenamedHsDecl],
205 FreeVars) -- Un-satisfied needs
206 -- The declaration (and hence home module) of each gate has
207 -- already been loaded
209 slurpSourceRefs source_fvs
210 = go_outer [] -- Accumulating decls
211 emptyFVs -- Unsatisfied needs
212 emptyFVs -- Accumulating gates
213 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
215 -- The outer loop repeatedly slurps the decls for the current gates
216 -- and the instance decls
218 -- The outer loop is needed because consider
220 go_outer decls fvs all_gates []
221 = returnRn (decls, fvs)
223 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
224 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
225 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
226 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
227 rnIfaceInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
228 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
229 (nameSetToList (gates2 `minusNameSet` all_gates))
230 -- Knock out the all_gates because even if we don't slurp any new
231 -- decls we can get some apparently-new gates from wired-in names
233 go_inner (decls, fvs, gates) wanted_name
234 = importDecl wanted_name `thenRn` \ import_result ->
235 case import_result of
236 AlreadySlurped -> returnRn (decls, fvs, gates)
237 InTypeEnv ty_thing -> returnRn (decls, fvs, gates `plusFV` getWiredInGates ty_thing)
239 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
240 returnRn (TyClD new_decl : decls,
242 gates `plusFV` getGates source_fvs new_decl)
247 -------------------------------------------------------
248 -- closeDecls keeps going until the free-var set is empty
249 closeDecls decls needed
250 | not (isEmptyFVs needed)
251 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
252 closeDecls decls1 needed1
255 = getImportedRules `thenRn` \ rule_decls ->
257 [] -> returnRn decls -- No new rules, so we are done
258 other -> rnIfaceDecls rnIfaceRuleDecl rule_decls `thenRn` \ rule_decls' ->
260 rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
262 traceRn (text "closeRules" <+> ppr rule_decls' $$ fsep (map ppr (nameSetToList rule_fvs))) `thenRn_`
263 closeDecls (map RuleD rule_decls' ++ decls) rule_fvs
267 -------------------------------------------------------
268 -- Augment decls with any decls needed by needed.
269 -- Return also free vars of the new decls (only)
270 slurpDecls decls needed
271 = go decls emptyFVs (nameSetToList needed)
273 go decls fvs [] = returnRn (decls, fvs)
274 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
277 -------------------------------------------------------
278 slurpDecl decls fvs wanted_name
279 = importDecl wanted_name `thenRn` \ import_result ->
280 case import_result of
281 -- Found a declaration... rename it
282 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
283 returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
285 -- No declaration... (wired in thing, or deferred, or already slurped)
286 other -> returnRn (decls, fvs)
289 -------------------------------------------------------
290 rnIfaceDecls rn decls = mapRn (rnIfaceDecl rn) decls
291 rnIfaceDecl rn (mod, decl) = initIfaceRnMS mod (rn decl)
293 rnIfaceInstDecls decls fvs gates inst_decls
294 = rnIfaceDecls rnInstDecl inst_decls `thenRn` \ inst_decls' ->
295 returnRn (map InstD inst_decls' ++ decls,
296 fvs `plusFV` plusFVs (map instDeclFVs inst_decls'),
297 gates `plusFV` plusFVs (map getInstDeclGates inst_decls'))
299 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl) `thenRn` \ decl' ->
300 returnRn (decl', tyClDeclFVs decl')
305 recordSlurp ifaces@(Ifaces { iDecls = (decls_map, n_slurped),
306 iSlurp = slurped_names,
307 iVSlurp = (imp_mods, imp_names) })
309 = ASSERT2( not (isLocalName (availName avail)), ppr avail )
310 ifaces { iDecls = (decls_map', n_slurped+1),
311 iSlurp = new_slurped_names,
312 iVSlurp = new_vslurp }
314 decls_map' = foldl delFromNameEnv decls_map (availNames avail)
315 main_name = availName avail
316 new_slurped_names = addAvailToNameSet slurped_names avail
317 new_vslurp | isHomePackageName main_name = (imp_mods, addOneToNameSet imp_names main_name)
318 | otherwise = (extendModuleSet imp_mods mod, imp_names)
319 mod = nameModule main_name
321 recordLocalSlurps new_names
322 = getIfacesRn `thenRn` \ ifaces ->
323 setIfacesRn (ifaces { iSlurp = iSlurp ifaces `unionNameSets` new_names })
328 %*********************************************************
330 \subsection{Extracting the `gates'}
332 %*********************************************************
336 We want to avoid sucking in too many instance declarations.
337 An instance decl is only useful if the types and classes mentioned in
338 its 'head' are all available in the program being compiled. E.g.
340 instance (..) => C (T1 a) (T2 b) where ...
342 is only useful if C, T1 and T2 are all "available". So we keep
343 instance decls that have been parsed from .hi files, but not yet
344 slurped in, in a pool called the 'gated instance pool'.
345 Each has its set of 'gates': {C, T1, T2} in the above example.
347 More precisely, the gates of a module are the types and classes
348 that are mentioned in:
351 b) the type of an Id that's mentioned in the source code
352 [includes constructors and selectors]
353 c) the RHS of a type synonym that is a gate
354 d) the superclasses of a class that is a gate
355 e) the context of an instance decl that is slurped in
357 We slurp in an instance decl from the gated instance pool iff
359 all its gates are either in the gates of the module,
360 or are a previously-loaded class.
362 The latter constraint is because there might have been an instance
363 decl slurped in during an earlier compilation, like this:
365 instance Foo a => Baz (Maybe a) where ...
367 In the module being compiled we might need (Baz (Maybe T)), where T
368 is defined in this module, and hence we need (Foo T). So @Foo@ becomes
369 a gate. But there's no way to 'see' that, so we simply treat all
370 previously-loaded classes as gates.
372 Consructors and class operations
373 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
374 When we import a declaration like
376 data T = T1 Wibble | T2 Wobble
378 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
379 @T1@, @T2@ respectively are mentioned by the user program. If only
380 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
381 in useless instance decls for (say) @Eq Wibble@, when they can't
384 And that's just what (b) says: we only treat T1's type as a gate if
385 T1 is mentioned. getGates, which deals with decls we are slurping in,
386 has to be a bit careful, because a mention of T1 will slurp in T's whole
389 -----------------------------
390 @getGates@ takes a newly imported (and renamed) decl, and the free
391 vars of the source program, and extracts from the decl the gate names.
394 getGates :: FreeVars -- Things mentioned in the source program
398 getGates source_fvs decl
399 = get_gates (\n -> n `elemNameSet` source_fvs) decl
401 get_gates is_used (IfaceSig {tcdType = ty}) = extractHsTyNames ty
403 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
404 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
406 `addOneToNameSet` cls)
407 `plusFV` implicitGates cls
409 get (ClassOpSig n _ ty _)
410 | is_used n = extractHsTyNames ty
411 | otherwise = emptyFVs
413 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
414 = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
415 -- A type synonym type constructor isn't a "gate" for instance decls
417 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
418 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
420 `addOneToNameSet` tycon
422 get (ConDecl n _ tvs ctxt details _)
424 -- If the constructor is method, get fvs from all its fields
425 = delListFromNameSet (get_details details `plusFV`
426 extractHsCtxtTyNames ctxt)
428 get (ConDecl n _ tvs ctxt (RecCon fields) _)
429 -- Even if the constructor isn't mentioned, the fields
430 -- might be, as selectors. They can't mention existentially
431 -- bound tyvars (typechecker checks for that) so no need for
432 -- the deleteListFromNameSet part
433 = foldr (plusFV . get_field) emptyFVs fields
435 get other_con = emptyFVs
437 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
438 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
439 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
441 get_field (fs,t) | any is_used fs = get_bang t
442 | otherwise = emptyFVs
444 get_bang bty = extractHsTyNames (getBangType bty)
447 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
448 thing rather than a declaration.
451 getWiredInGates :: TyThing -> FreeVars
452 -- The TyThing is one that we already have in our type environment, either
453 -- a) because the TyCon or Id is wired in, or
454 -- b) from a previous compile
455 -- Either way, we might have instance decls in the (persistent) collection
456 -- of parsed-but-not-slurped instance decls that should be slurped in.
457 -- This might be the first module that mentions both the type and the class
458 -- for that instance decl, even though both the type and the class were
459 -- mentioned in other modules, and hence are in the type environment
461 getWiredInGates (AnId the_id) = namesOfType (idType the_id)
462 getWiredInGates (AClass cl) = emptyFVs -- The superclasses must also be previously
463 -- loaded, and hence are automatically gates
464 getWiredInGates (ATyCon tc)
465 | isSynTyCon tc = delListFromNameSet (namesOfType ty) (map getName tyvars)
466 | otherwise = unitFV (getName tc)
468 (tyvars,ty) = getSynTyConDefn tc
470 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
474 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameInstDecl)]
475 getImportedInstDecls gates
476 = -- First, load any orphan-instance modules that aren't aready loaded
477 -- Orphan-instance modules are recorded in the module dependecnies
478 getIfacesRn `thenRn` \ ifaces ->
481 [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
483 loadOrphanModules orphan_mods `thenRn_`
485 -- Now we're ready to grab the instance declarations
486 -- Find the un-gated ones and return them,
487 -- removing them from the bag kept in Ifaces
488 getIfacesRn `thenRn` \ ifaces ->
489 getTypeEnvRn `thenRn` \ lookup ->
491 (decls, new_insts) = selectGated gates lookup (iInsts ifaces)
493 setIfacesRn (ifaces { iInsts = new_insts }) `thenRn_`
495 traceRn (sep [text "getImportedInstDecls:",
496 nest 4 (fsep (map ppr gate_list)),
497 text "Slurped" <+> int (length decls) <+> text "instance declarations",
498 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenRn_`
501 gate_list = nameSetToList gates
503 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
505 HsForAllTy _ _ tau -> ppr tau
508 getImportedRules :: RnMG [(Module,RdrNameRuleDecl)]
510 | opt_IgnoreIfacePragmas = returnRn []
512 = getIfacesRn `thenRn` \ ifaces ->
513 getTypeEnvRn `thenRn` \ lookup ->
515 gates = iSlurp ifaces -- Anything at all that's been slurped
516 rules = iRules ifaces
517 (decls, new_rules) = selectGated gates lookup rules
522 setIfacesRn (ifaces { iRules = new_rules }) `thenRn_`
523 traceRn (sep [text "getImportedRules:",
524 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenRn_`
527 selectGated gates lookup (decl_bag, n_slurped)
528 -- Select only those decls whose gates are *all* in 'gates'
529 -- or are a class in 'lookup'
531 | opt_NoPruneDecls -- Just to try the effect of not gating at all
533 decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag -- Grab them all
535 (decls, (emptyBag, n_slurped + length decls))
539 = case foldrBag select ([], emptyBag) decl_bag of
540 (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
542 available n = n `elemNameSet` gates
543 || case lookup n of { Just (AClass c) -> True; other -> False }
545 select (reqd, decl) (yes, no)
546 | all available reqd = (decl:yes, no)
547 | otherwise = (yes, (reqd,decl) `consBag` no)
551 %*********************************************************
553 \subsection{Getting in a declaration}
555 %*********************************************************
558 importDecl :: Name -> RnMG ImportDeclResult
560 data ImportDeclResult
563 | HereItIs (Module, RdrNameTyClDecl)
566 = -- STEP 1: Check if we've slurped it in while compiling this module
567 getIfacesRn `thenRn` \ ifaces ->
568 if name `elemNameSet` iSlurp ifaces then
569 returnRn AlreadySlurped
572 -- STEP 2: Check if it's already in the type environment
573 getTypeEnvRn `thenRn` \ lookup ->
574 case lookup name of {
575 Just ty_thing | name `elemNameEnv` wiredInThingEnv
576 -> -- When we find a wired-in name we must load its home
577 -- module so that we find any instance decls lurking therein
578 loadHomeInterface wi_doc name `thenRn_`
579 returnRn (InTypeEnv ty_thing)
582 -> returnRn (InTypeEnv ty_thing) ;
586 -- STEP 3: OK, we have to slurp it in from an interface file
587 -- First load the interface file
588 traceRn nd_doc `thenRn_`
589 loadHomeInterface nd_doc name `thenRn_`
590 getIfacesRn `thenRn` \ ifaces ->
592 -- STEP 4: Get the declaration out
594 (decls_map, _) = iDecls ifaces
596 case lookupNameEnv decls_map name of
598 -> setIfacesRn (recordSlurp ifaces avail) `thenRn_`
599 returnRn (HereItIs decl)
602 -> addErrRn (getDeclErr name) `thenRn_`
603 returnRn AlreadySlurped
606 wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
607 nd_doc = ptext SLIT("need decl for") <+> ppr name
612 %********************************************************
614 \subsection{Checking usage information}
616 %********************************************************
618 @recompileRequired@ is called from the HscMain. It checks whether
619 a recompilation is required. It needs access to the persistent state,
620 finder, etc, because it may have to load lots of interface files to
621 check their versions.
624 type RecompileRequired = Bool
625 upToDate = False -- Recompile not required
626 outOfDate = True -- Recompile required
628 recompileRequired :: FilePath -- Only needed for debug msgs
629 -> ModIface -- Old interface
630 -> RnMG RecompileRequired
631 recompileRequired iface_path iface
632 = traceHiDiffsRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
634 -- Source code unchanged and no errors yet... carry on
635 checkList [checkModUsage u | u <- mi_usages iface]
637 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
638 checkList [] = returnRn upToDate
639 checkList (check:checks) = check `thenRn` \ recompile ->
647 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
648 -- Given the usage information extracted from the old
649 -- M.hi file for the module being compiled, figure out
650 -- whether M needs to be recompiled.
652 checkModUsage (mod_name, _, _, NothingAtAll)
653 -- If CurrentModule.hi contains
655 -- then that simply records that Foo lies below CurrentModule in the
656 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
657 -- In this case we don't even want to open Foo's interface.
658 = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
660 checkModUsage (mod_name, _, is_boot, whats_imported)
661 = -- Load the imported interface is possible
662 -- We use tryLoadInterface, because failure is not an error
663 -- (might just be that the old .hi file for this module is out of date)
664 -- We use ImportByUser/ImportByUserSource as the 'from' flag,
665 -- a) because we need to know whether to load the .hi-boot file
666 -- b) because loadInterface things matters are amiss if we
667 -- ImportBySystem an interface it knows nothing about
669 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
670 from | is_boot = ImportByUserSource
671 | otherwise = ImportByUser
673 tryLoadInterface doc_str mod_name from `thenRn` \ (iface, maybe_err) ->
676 Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
678 -- Couldn't find or parse a module mentioned in the
679 -- old interface file. Don't complain -- it might just be that
680 -- the current module doesn't need that import and it's been deleted
684 new_vers = mi_version iface
685 new_decl_vers = vers_decls new_vers
687 case whats_imported of { -- NothingAtAll dealt with earlier
689 Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
691 out_of_date (ptext SLIT("...and I needed the whole module"))
695 Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
698 checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
699 if not recompile then
704 if checkExportList maybe_old_export_vers new_vers then
705 out_of_date (ptext SLIT("Export list changed"))
709 if old_rule_vers /= vers_rules new_vers then
710 out_of_date (ptext SLIT("Rules changed"))
713 -- CHECK ITEMS ONE BY ONE
714 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenRn` \ recompile ->
716 returnRn outOfDate -- This one failed, so just bail out now
718 up_to_date (ptext SLIT("...but the bits I use haven't."))
722 ------------------------
723 checkModuleVersion old_mod_vers new_vers
724 | vers_module new_vers == old_mod_vers
725 = up_to_date (ptext SLIT("Module version unchanged"))
728 = out_of_date (ptext SLIT("Module version has changed"))
730 ------------------------
731 checkExportList Nothing new_vers = upToDate
732 checkExportList (Just v) new_vers = v /= vers_exports new_vers
734 ------------------------
735 checkEntityUsage new_vers (name,old_vers)
736 = case lookupNameEnv new_vers name of
738 Nothing -> -- We used it before, but it ain't there now
739 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
741 Just new_vers -- It's there, but is it up to date?
742 | new_vers == old_vers -> returnRn upToDate
743 | otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
745 up_to_date msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
746 out_of_date msg = traceHiDiffsRn msg `thenRn_` returnRn outOfDate
750 %*********************************************************
754 %*********************************************************
758 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
759 ptext SLIT("from module") <+> quotes (ppr (nameModule name))