2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
13 slurpImpDecls, closeDecls,
15 RecompileRequired, outOfDate, upToDate, recompileRequired
19 #include "HsVersions.h"
21 import CmdLineOpts ( opt_IgnoreIfacePragmas, opt_NoPruneDecls )
23 import HsSyn ( HsDecl(..), Sig(..), TyClDecl(..), ConDecl(..), ConDetails(..),
24 InstDecl(..), HsType(..), hsTyVarNames, getBangType
26 import HsImpExp ( ImportDecl(..) )
27 import RdrHsSyn ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
28 import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl,
29 extractHsTyNames, extractHsCtxtTyNames,
30 tyClDeclFVs, ruleDeclFVs, instDeclFVs
32 import RnHiFiles ( tryLoadInterface, loadHomeInterface, loadInterface,
35 import RnSource ( rnTyClDecl, rnInstDecl, rnIfaceRuleDecl )
39 import Type ( namesOfType )
40 import TyCon ( isSynTyCon, getSynTyConDefn )
41 import Name ( Name {-instance NamedThing-}, nameOccName,
42 nameModule, isLocalName, nameUnique,
45 import Name ( elemNameEnv, delFromNameEnv )
46 import Module ( Module, ModuleEnv,
47 moduleName, isModuleInThisPackage,
48 ModuleName, WhereFrom(..),
50 extendModuleEnv_C, foldModuleEnv, lookupModuleEnv,
51 elemModuleSet, extendModuleSet
54 import PrelInfo ( wiredInThingEnv, fractionalClassKeys )
55 import TysWiredIn ( doubleTyCon )
56 import Maybes ( orElse )
60 import Util ( sortLt )
64 %*********************************************************
66 \subsection{Getting what a module exports}
68 %*********************************************************
70 @getInterfaceExports@ is called only for directly-imported modules.
73 getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, [(ModuleName,Avails)])
74 getInterfaceExports mod_name from
75 = loadInterface doc_str mod_name from `thenRn` \ iface ->
76 returnRn (mi_module iface, mi_exports iface)
78 doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")]
82 %*********************************************************
84 \subsection{Keeping track of what we've slurped, and version numbers}
86 %*********************************************************
88 mkImportInof figures out what the ``usage information'' for this
89 moudule is; that is, what it must record in its interface file as the
92 We produce a line for every module B below the module, A, currently being
95 to record the fact that A does import B indireclty. This is used to decide
96 to look to look for B.hi rather than B.hi-boot when compiling a module that
97 imports A. This line says that A imports B, but uses nothing in it.
98 So we'll get an early bale-out when compiling A if B's version changes.
101 mkImportInfo :: ModuleName -- Name of this module
102 -> [ImportDecl n] -- The import decls
103 -> RnMG [ImportVersion Name]
105 mkImportInfo this_mod imports
106 = getIfacesRn `thenRn` \ ifaces ->
107 getHomeIfaceTableRn `thenRn` \ hit ->
109 (imp_pkg_mods, imp_home_names) = iVSlurp ifaces
112 import_all_mods :: [ModuleName]
113 -- Modules where we imported all the names
114 -- (apart from hiding some, perhaps)
115 import_all_mods = [ m | ImportDecl m _ _ _ imp_list _ <- imports,
116 import_all imp_list ]
118 import_all (Just (False, _)) = False -- Imports are specified explicitly
119 import_all other = True -- Everything is imported
121 -- mv_map groups together all the things imported and used
122 -- from a particular module in this package
123 -- We use a finite map because we want the domain
124 mv_map :: ModuleEnv [Name]
125 mv_map = foldNameSet add_mv emptyModuleEnv imp_home_names
126 add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
128 mod = nameModule name
129 add_item names _ = name:names
131 -- In our usage list we record
132 -- a) Specifically: Detailed version info for imports from modules in this package
133 -- Gotten from iVSlurp plus import_all_mods
135 -- b) Everything: Just the module version for imports from modules in other packages
136 -- Gotten from iVSlurp plus import_all_mods
138 -- c) NothingAtAll: The name only of modules, Baz, in this package that are 'below' us,
139 -- but which we didn't need at all (this is needed only to decide whether
140 -- to open Baz.hi or Baz.hi-boot higher up the tree).
141 -- This happens when a module, Foo, that we explicitly imported has
142 -- 'import Baz' in its interface file, recording that Baz is below
143 -- Foo in the module dependency hierarchy. We want to propagate this info.
144 -- These modules are in a combination of HIT/PIT and iImpModInfo
146 -- d) NothingAtAll: The name only of all orphan modules we know of (this is needed
147 -- so that anyone who imports us can find the orphan modules)
148 -- These modules are in a combination of HIT/PIT and iImpModInfo
150 import_info0 = foldModuleEnv mk_imp_info [] pit
151 import_info1 = foldModuleEnv mk_imp_info import_info0 hit
152 import_info = [ (mod_name, orphans, is_boot, NothingAtAll)
153 | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ] ++
156 mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
157 mk_imp_info iface so_far
159 | Just ns <- lookupModuleEnv mv_map mod -- Case (a)
160 = go_for_it (Specifically mod_vers maybe_export_vers
161 (mk_import_items ns) rules_vers)
163 | mod `elemModuleSet` imp_pkg_mods -- Case (b)
164 = go_for_it (Everything mod_vers)
166 | import_all_mod -- Case (a) and (b); the import-all part
167 = if is_home_pkg_mod then
168 go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
170 go_for_it (Everything mod_vers)
172 | is_home_pkg_mod || has_orphans -- Case (c) or (d)
173 = go_for_it NothingAtAll
177 go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
179 mod = mi_module iface
180 mod_name = moduleName mod
181 is_home_pkg_mod = isModuleInThisPackage mod
182 version_info = mi_version iface
183 version_env = vers_decls version_info
184 mod_vers = vers_module version_info
185 rules_vers = vers_rules version_info
186 export_vers = vers_exports version_info
187 import_all_mod = mod_name `elem` import_all_mods
188 has_orphans = mi_orphan iface
190 -- The sort is to put them into canonical order
191 mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
192 let v = lookupNameEnv version_env n `orElse`
193 pprPanic "mk_whats_imported" (ppr n)
196 lt_occ n1 n2 = nameOccName n1 < nameOccName n2
198 maybe_export_vers | import_all_mod = Just (vers_exports version_info)
199 | otherwise = Nothing
204 %*********************************************************
206 \subsection{Slurping declarations}
208 %*********************************************************
211 -------------------------------------------------------
212 slurpImpDecls source_fvs
213 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
215 -- The current slurped-set records all local things
216 getSlurped `thenRn` \ source_binders ->
217 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
219 -- Then get everything else
220 closeDecls decls needed
223 -------------------------------------------------------
224 slurpSourceRefs :: NameSet -- Variables defined in source
225 -> FreeVars -- Variables referenced in source
226 -> RnMG ([RenamedHsDecl],
227 FreeVars) -- Un-satisfied needs
228 -- The declaration (and hence home module) of each gate has
229 -- already been loaded
231 slurpSourceRefs source_binders source_fvs
232 = go_outer [] -- Accumulating decls
233 emptyFVs -- Unsatisfied needs
234 emptyFVs -- Accumulating gates
235 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
237 -- The outer loop repeatedly slurps the decls for the current gates
238 -- and the instance decls
240 -- The outer loop is needed because consider
242 go_outer decls fvs all_gates []
243 = returnRn (decls, fvs)
245 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
246 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
247 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
248 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
249 rnIfaceInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
250 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
251 (nameSetToList (gates2 `minusNameSet` all_gates))
252 -- Knock out the all_gates because even if we don't slurp any new
253 -- decls we can get some apparently-new gates from wired-in names
255 go_inner (decls, fvs, gates) wanted_name
256 = importDecl wanted_name `thenRn` \ import_result ->
257 case import_result of
258 AlreadySlurped -> returnRn (decls, fvs, gates)
259 InTypeEnv ty_thing -> returnRn (decls, fvs, gates `plusFV` getWiredInGates ty_thing)
261 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
262 returnRn (TyClD new_decl : decls,
264 gates `plusFV` getGates source_fvs new_decl)
269 -------------------------------------------------------
270 -- closeDecls keeps going until the free-var set is empty
271 closeDecls decls needed
272 | not (isEmptyFVs needed)
273 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
274 closeDecls decls1 needed1
277 = getImportedRules `thenRn` \ rule_decls ->
279 [] -> returnRn decls -- No new rules, so we are done
280 other -> rnIfaceDecls rnIfaceRuleDecl rule_decls `thenRn` \ rule_decls' ->
282 rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
284 traceRn (text "closeRules" <+> ppr rule_decls' $$ fsep (map ppr (nameSetToList rule_fvs))) `thenRn_`
285 closeDecls (map RuleD rule_decls' ++ decls) rule_fvs
289 -------------------------------------------------------
290 -- Augment decls with any decls needed by needed.
291 -- Return also free vars of the new decls (only)
292 slurpDecls decls needed
293 = go decls emptyFVs (nameSetToList needed)
295 go decls fvs [] = returnRn (decls, fvs)
296 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
299 -------------------------------------------------------
300 slurpDecl decls fvs wanted_name
301 = importDecl wanted_name `thenRn` \ import_result ->
302 case import_result of
303 -- Found a declaration... rename it
304 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
305 returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
307 -- No declaration... (wired in thing, or deferred, or already slurped)
308 other -> returnRn (decls, fvs)
311 -------------------------------------------------------
312 rnIfaceDecls rn decls = mapRn (rnIfaceDecl rn) decls
313 rnIfaceDecl rn (mod, decl) = initIfaceRnMS mod (rn decl)
315 rnIfaceInstDecls decls fvs gates inst_decls
316 = rnIfaceDecls rnInstDecl inst_decls `thenRn` \ inst_decls' ->
317 returnRn (map InstD inst_decls' ++ decls,
318 fvs `plusFV` plusFVs (map instDeclFVs inst_decls'),
319 gates `plusFV` plusFVs (map getInstDeclGates inst_decls'))
321 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl) `thenRn` \ decl' ->
322 returnRn (decl', tyClDeclFVs decl')
328 = getIfacesRn `thenRn` \ ifaces ->
329 returnRn (iSlurp ifaces)
331 recordSlurp ifaces@(Ifaces { iDecls = (decls_map, n_slurped),
332 iSlurp = slurped_names,
333 iVSlurp = (imp_mods, imp_names) })
335 = ASSERT2( not (isLocalName (availName avail)), ppr avail )
336 ifaces { iDecls = (decls_map', n_slurped+1),
337 iSlurp = new_slurped_names,
338 iVSlurp = new_vslurp }
340 decls_map' = foldl delFromNameEnv decls_map (availNames avail)
341 main_name = availName avail
342 mod = nameModule main_name
343 new_slurped_names = addAvailToNameSet slurped_names avail
344 new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names main_name)
345 | otherwise = (extendModuleSet imp_mods mod, imp_names)
347 recordLocalSlurps local_avails
348 = getIfacesRn `thenRn` \ ifaces ->
350 new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
352 setIfacesRn (ifaces { iSlurp = new_slurped_names })
357 %*********************************************************
359 \subsection{Extracting the `gates'}
361 %*********************************************************
365 We want to avoid sucking in too many instance declarations.
366 An instance decl is only useful if the types and classes mentioned in
367 its 'head' are all available in the program being compiled. E.g.
369 instance (..) => C (T1 a) (T2 b) where ...
371 is only useful if C, T1 and T2 are all "available". So we keep
372 instance decls that have been parsed from .hi files, but not yet
373 slurped in, in a pool called the 'gated instance pool'.
374 Each has its set of 'gates': {C, T1, T2} in the above example.
376 More precisely, the gates of a module are the types and classes
377 that are mentioned in:
380 b) the type of an Id that's mentioned in the source code
381 [includes constructors and selectors]
382 c) the RHS of a type synonym that is a gate
383 d) the superclasses of a class that is a gate
384 e) the context of an instance decl that is slurped in
386 We slurp in an instance decl from the gated instance pool iff
388 all its gates are either in the gates of the module,
389 or are a previously-loaded class.
391 The latter constraint is because there might have been an instance
392 decl slurped in during an earlier compilation, like this:
394 instance Foo a => Baz (Maybe a) where ...
396 In the module being compiled we might need (Baz (Maybe T)), where T
397 is defined in this module, and hence we need (Foo T). So @Foo@ becomes
398 a gate. But there's no way to 'see' that, so we simply treat all
399 previously-loaded classes as gates.
401 Consructors and class operations
402 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
403 When we import a declaration like
405 data T = T1 Wibble | T2 Wobble
407 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
408 @T1@, @T2@ respectively are mentioned by the user program. If only
409 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
410 in useless instance decls for (say) @Eq Wibble@, when they can't
413 And that's just what (b) says: we only treat T1's type as a gate if
414 T1 is mentioned. getGates, which deals with decls we are slurping in,
415 has to be a bit careful, because a mention of T1 will slurp in T's whole
418 -----------------------------
419 @getGates@ takes a newly imported (and renamed) decl, and the free
420 vars of the source program, and extracts from the decl the gate names.
423 getGates :: FreeVars -- Things mentioned in the source program
427 getGates source_fvs decl
428 = get_gates (\n -> n `elemNameSet` source_fvs) decl
430 get_gates is_used (IfaceSig _ ty _ _)
431 = extractHsTyNames ty
433 get_gates is_used (ClassDecl ctxt cls tvs _ sigs _ _ _ )
434 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
436 `addOneToNameSet` cls)
437 `plusFV` maybe_double
439 get (ClassOpSig n _ ty _)
440 | is_used n = extractHsTyNames ty
441 | otherwise = emptyFVs
443 -- If we load any numeric class that doesn't have
444 -- Int as an instance, add Double to the gates.
445 -- This takes account of the fact that Double might be needed for
446 -- defaulting, but we don't want to load Double (and all its baggage)
447 -- if the more exotic classes aren't used at all.
448 maybe_double | nameUnique cls `elem` fractionalClassKeys
449 = unitFV (getName doubleTyCon)
453 get_gates is_used (TySynonym tycon tvs ty _)
454 = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
455 -- A type synonym type constructor isn't a "gate" for instance decls
457 get_gates is_used (TyData _ ctxt tycon tvs cons _ _ _ _ _)
458 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
460 `addOneToNameSet` tycon
462 get (ConDecl n _ tvs ctxt details _)
464 -- If the constructor is method, get fvs from all its fields
465 = delListFromNameSet (get_details details `plusFV`
466 extractHsCtxtTyNames ctxt)
468 get (ConDecl n _ tvs ctxt (RecCon fields) _)
469 -- Even if the constructor isn't mentioned, the fields
470 -- might be, as selectors. They can't mention existentially
471 -- bound tyvars (typechecker checks for that) so no need for
472 -- the deleteListFromNameSet part
473 = foldr (plusFV . get_field) emptyFVs fields
475 get other_con = emptyFVs
477 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
478 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
479 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
481 get_field (fs,t) | any is_used fs = get_bang t
482 | otherwise = emptyFVs
484 get_bang bty = extractHsTyNames (getBangType bty)
487 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
488 thing rather than a declaration.
491 getWiredInGates :: TyThing -> FreeVars
492 -- The TyThing is one that we already have in our type environment, either
493 -- a) because the TyCon or Id is wired in, or
494 -- b) from a previous compile
495 -- Either way, we might have instance decls in the (persistent) collection
496 -- of parsed-but-not-slurped instance decls that should be slurped in.
497 -- This might be the first module that mentions both the type and the class
498 -- for that instance decl, even though both the type and the class were
499 -- mentioned in other modules, and hence are in the type environment
501 getWiredInGates (AnId the_id) = namesOfType (idType the_id)
502 getWiredInGates (AClass cl) = emptyFVs -- The superclasses must also be previously
503 -- loaded, and hence are automatically gates
504 getWiredInGates (ATyCon tc)
505 | isSynTyCon tc = delListFromNameSet (namesOfType ty) (map getName tyvars)
506 | otherwise = unitFV (getName tc)
508 (tyvars,ty) = getSynTyConDefn tc
510 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
514 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameInstDecl)]
515 getImportedInstDecls gates
516 = -- First, load any orphan-instance modules that aren't aready loaded
517 -- Orphan-instance modules are recorded in the module dependecnies
518 getIfacesRn `thenRn` \ ifaces ->
521 [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
523 loadOrphanModules orphan_mods `thenRn_`
525 -- Now we're ready to grab the instance declarations
526 -- Find the un-gated ones and return them,
527 -- removing them from the bag kept in Ifaces
528 getIfacesRn `thenRn` \ ifaces ->
529 getTypeEnvRn `thenRn` \ lookup ->
531 (decls, new_insts) = selectGated gates lookup (iInsts ifaces)
533 setIfacesRn (ifaces { iInsts = new_insts }) `thenRn_`
535 traceRn (sep [text "getImportedInstDecls:",
536 nest 4 (fsep (map ppr gate_list)),
537 text "Slurped" <+> int (length decls) <+> text "instance declarations",
538 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenRn_`
541 gate_list = nameSetToList gates
543 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
545 HsForAllTy _ _ tau -> ppr tau
548 getImportedRules :: RnMG [(Module,RdrNameRuleDecl)]
550 | opt_IgnoreIfacePragmas = returnRn []
552 = getIfacesRn `thenRn` \ ifaces ->
553 getTypeEnvRn `thenRn` \ lookup ->
555 gates = iSlurp ifaces -- Anything at all that's been slurped
556 rules = iRules ifaces
557 (decls, new_rules) = selectGated gates lookup rules
562 setIfacesRn (ifaces { iRules = new_rules }) `thenRn_`
563 traceRn (sep [text "getImportedRules:",
564 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenRn_`
567 selectGated gates lookup (decl_bag, n_slurped)
568 -- Select only those decls whose gates are *all* in 'gates'
569 -- or are a class in 'lookup'
571 | opt_NoPruneDecls -- Just to try the effect of not gating at all
573 decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag -- Grab them all
575 (decls, (emptyBag, n_slurped + length decls))
579 = case foldrBag select ([], emptyBag) decl_bag of
580 (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
582 available n = n `elemNameSet` gates
583 || case lookup n of { Just (AClass c) -> True; other -> False }
585 select (reqd, decl) (yes, no)
586 | all available reqd = (decl:yes, no)
587 | otherwise = (yes, (reqd,decl) `consBag` no)
591 %*********************************************************
593 \subsection{Getting in a declaration}
595 %*********************************************************
598 importDecl :: Name -> RnMG ImportDeclResult
600 data ImportDeclResult
603 | HereItIs (Module, RdrNameTyClDecl)
606 = -- STEP 1: Check if it was loaded before beginning this module
607 if isLocalName name then
608 traceRn (text "Already (local)" <+> ppr name) `thenRn_`
609 returnRn AlreadySlurped
612 -- STEP 2: Check if we've slurped it in while compiling this module
613 getIfacesRn `thenRn` \ ifaces ->
614 if name `elemNameSet` iSlurp ifaces then
615 returnRn AlreadySlurped
618 -- STEP 3: Check if it's already in the type environment
619 getTypeEnvRn `thenRn` \ lookup ->
620 case lookup name of {
621 Just ty_thing | name `elemNameEnv` wiredInThingEnv
622 -> -- When we find a wired-in name we must load its home
623 -- module so that we find any instance decls lurking therein
624 loadHomeInterface wi_doc name `thenRn_`
625 returnRn (InTypeEnv ty_thing)
628 -> returnRn (InTypeEnv ty_thing) ;
632 -- STEP 4: OK, we have to slurp it in from an interface file
633 -- First load the interface file
634 traceRn nd_doc `thenRn_`
635 loadHomeInterface nd_doc name `thenRn_`
636 getIfacesRn `thenRn` \ ifaces ->
638 -- STEP 5: Get the declaration out
640 (decls_map, _) = iDecls ifaces
642 case lookupNameEnv decls_map name of
644 -> setIfacesRn (recordSlurp ifaces avail) `thenRn_`
645 returnRn (HereItIs decl)
648 -> addErrRn (getDeclErr name) `thenRn_`
649 returnRn AlreadySlurped
652 wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
653 nd_doc = ptext SLIT("need decl for") <+> ppr name
658 %********************************************************
660 \subsection{Checking usage information}
662 %********************************************************
664 @recompileRequired@ is called from the HscMain. It checks whether
665 a recompilation is required. It needs access to the persistent state,
666 finder, etc, because it may have to load lots of interface files to
667 check their versions.
670 type RecompileRequired = Bool
671 upToDate = False -- Recompile not required
672 outOfDate = True -- Recompile required
674 recompileRequired :: FilePath -- Only needed for debug msgs
675 -> Bool -- Source unchanged
676 -> ModIface -- Old interface
677 -> RnMG RecompileRequired
678 recompileRequired iface_path source_unchanged iface
679 = traceHiDiffsRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
681 -- CHECK WHETHER THE SOURCE HAS CHANGED
682 if not source_unchanged then
683 traceHiDiffsRn (nest 4 (text "Source file changed or recompilation check turned off")) `thenRn_`
687 -- Source code unchanged and no errors yet... carry on
688 checkList [checkModUsage u | u <- mi_usages iface]
690 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
691 checkList [] = returnRn upToDate
692 checkList (check:checks) = check `thenRn` \ recompile ->
700 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
701 -- Given the usage information extracted from the old
702 -- M.hi file for the module being compiled, figure out
703 -- whether M needs to be recompiled.
705 checkModUsage (mod_name, _, _, NothingAtAll)
706 -- If CurrentModule.hi contains
708 -- then that simply records that Foo lies below CurrentModule in the
709 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
710 -- In this case we don't even want to open Foo's interface.
711 = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
713 checkModUsage (mod_name, _, is_boot, whats_imported)
714 = -- Load the imported interface is possible
715 -- We use tryLoadInterface, because failure is not an error
716 -- (might just be that the old .hi file for this module is out of date)
717 -- We use ImportByUser/ImportByUserSource as the 'from' flag,
718 -- a) because we need to know whether to load the .hi-boot file
719 -- b) because loadInterface things matters are amiss if we
720 -- ImportBySystem an interface it knows nothing about
722 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
723 from | is_boot = ImportByUserSource
724 | otherwise = ImportByUser
726 tryLoadInterface doc_str mod_name from `thenRn` \ (iface, maybe_err) ->
729 Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
731 -- Couldn't find or parse a module mentioned in the
732 -- old interface file. Don't complain -- it might just be that
733 -- the current module doesn't need that import and it's been deleted
737 new_vers = mi_version iface
738 new_decl_vers = vers_decls new_vers
740 case whats_imported of { -- NothingAtAll dealt with earlier
742 Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
744 out_of_date (ptext SLIT("...and I needed the whole module"))
748 Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
751 checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
752 if not recompile then
757 if checkExportList maybe_old_export_vers new_vers then
758 out_of_date (ptext SLIT("Export list changed"))
762 if old_rule_vers /= vers_rules new_vers then
763 out_of_date (ptext SLIT("Rules changed"))
766 -- CHECK ITEMS ONE BY ONE
767 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenRn` \ recompile ->
769 returnRn outOfDate -- This one failed, so just bail out now
771 up_to_date (ptext SLIT("...but the bits I use haven't."))
775 ------------------------
776 checkModuleVersion old_mod_vers new_vers
777 | vers_module new_vers == old_mod_vers
778 = up_to_date (ptext SLIT("Module version unchanged"))
781 = out_of_date (ptext SLIT("Module version has changed"))
783 ------------------------
784 checkExportList Nothing new_vers = upToDate
785 checkExportList (Just v) new_vers = v /= vers_exports new_vers
787 ------------------------
788 checkEntityUsage new_vers (name,old_vers)
789 = case lookupNameEnv new_vers name of
791 Nothing -> -- We used it before, but it ain't there now
792 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
794 Just new_vers -- It's there, but is it up to date?
795 | new_vers == old_vers -> returnRn upToDate
796 | otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
798 up_to_date msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
799 out_of_date msg = traceHiDiffsRn msg `thenRn_` returnRn outOfDate
803 %*********************************************************
807 %*********************************************************
811 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
812 ptext SLIT("from module") <+> quotes (ppr (nameModule name))