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 )
37 import Id ( idType, idName, globalIdDetails )
38 import IdInfo ( GlobalIdDetails(..) )
39 import Type ( namesOfType )
40 import FieldLabel ( fieldLabelTyCon )
41 import DataCon ( dataConTyCon )
42 import TyCon ( isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
43 import Class ( className )
44 import Name ( Name {-instance NamedThing-}, nameOccName,
45 nameModule, isLocalName, NamedThing(..)
47 import NameEnv ( elemNameEnv, delFromNameEnv, lookupNameEnv )
49 import Module ( Module, ModuleEnv,
50 moduleName, isHomeModule,
51 ModuleName, WhereFrom(..),
53 extendModuleEnv_C, foldModuleEnv, lookupModuleEnv,
54 elemModuleSet, extendModuleSet
56 import PrelInfo ( wiredInThingEnv )
57 import Maybes ( maybeToBool )
61 import Util ( sortLt )
65 %*********************************************************
67 \subsection{Keeping track of what we've slurped, and version numbers}
69 %*********************************************************
71 mkImportInof figures out what the ``usage information'' for this
72 moudule is; that is, what it must record in its interface file as the
75 We produce a line for every module B below the module, A, currently being
78 to record the fact that A does import B indireclty. This is used to decide
79 to look to look for B.hi rather than B.hi-boot when compiling a module that
80 imports A. This line says that A imports B, but uses nothing in it.
81 So we'll get an early bale-out when compiling A if B's version changes.
84 mkImportInfo :: ModuleName -- Name of this module
85 -> [ImportDecl n] -- The import decls
86 -> RnMG [ImportVersion Name]
88 mkImportInfo this_mod imports
89 = getIfacesRn `thenRn` \ ifaces ->
90 getHomeIfaceTableRn `thenRn` \ hit ->
92 (imp_pkg_mods, imp_home_names) = iVSlurp ifaces
95 import_all_mods :: [ModuleName]
96 -- Modules where we imported all the names
97 -- (apart from hiding some, perhaps)
98 import_all_mods = [ m | ImportDecl m _ _ _ imp_list _ <- imports,
101 import_all (Just (False, _)) = False -- Imports are specified explicitly
102 import_all other = True -- Everything is imported
104 -- mv_map groups together all the things imported and used
105 -- from a particular module in this package
106 -- We use a finite map because we want the domain
107 mv_map :: ModuleEnv [Name]
108 mv_map = foldNameSet add_mv emptyModuleEnv imp_home_names
109 add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
111 mod = nameModule name
112 add_item names _ = name:names
114 -- In our usage list we record
115 -- a) Specifically: Detailed version info for imports from modules in this package
116 -- Gotten from iVSlurp plus import_all_mods
118 -- b) Everything: Just the module version for imports from modules in other packages
119 -- Gotten from iVSlurp plus import_all_mods
121 -- c) NothingAtAll: The name only of modules, Baz, in this package that are 'below' us,
122 -- but which we didn't need at all (this is needed only to decide whether
123 -- to open Baz.hi or Baz.hi-boot higher up the tree).
124 -- This happens when a module, Foo, that we explicitly imported has
125 -- 'import Baz' in its interface file, recording that Baz is below
126 -- Foo in the module dependency hierarchy. We want to propagate this info.
127 -- These modules are in a combination of HIT/PIT and iImpModInfo
129 -- d) NothingAtAll: The name only of all orphan modules we know of (this is needed
130 -- so that anyone who imports us can find the orphan modules)
131 -- These modules are in a combination of HIT/PIT and iImpModInfo
133 import_info0 = foldModuleEnv mk_imp_info [] pit
134 import_info1 = foldModuleEnv mk_imp_info import_info0 hit
135 import_info = [ (mod_name, orphans, is_boot, NothingAtAll)
136 | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ] ++
139 mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
140 mk_imp_info iface so_far
142 | Just ns <- lookupModuleEnv mv_map mod -- Case (a)
143 = go_for_it (Specifically mod_vers maybe_export_vers
144 (mk_import_items ns) rules_vers)
146 | mod `elemModuleSet` imp_pkg_mods -- Case (b)
147 = go_for_it (Everything mod_vers)
149 | import_all_mod -- Case (a) and (b); the import-all part
150 = if is_home_pkg_mod then
151 go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
153 go_for_it (Everything mod_vers)
155 | is_home_pkg_mod || has_orphans -- Case (c) or (d)
156 = go_for_it NothingAtAll
160 go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
162 mod = mi_module iface
163 mod_name = moduleName mod
164 is_home_pkg_mod = isHomeModule mod
165 version_info = mi_version iface
166 version_env = vers_decls version_info
167 mod_vers = vers_module version_info
168 rules_vers = vers_rules version_info
169 export_vers = vers_exports version_info
170 import_all_mod = mod_name `elem` import_all_mods
171 has_orphans = mi_orphan iface
173 -- The sort is to put them into canonical order
174 mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
175 let v = lookupVersion version_env n
178 lt_occ n1 n2 = nameOccName n1 < nameOccName n2
180 maybe_export_vers | import_all_mod = Just (vers_exports version_info)
181 | otherwise = Nothing
186 %*********************************************************
188 \subsection{Slurping declarations}
190 %*********************************************************
193 -------------------------------------------------------
194 slurpImpDecls source_fvs
195 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
197 -- The current slurped-set records all local things
198 slurpSourceRefs source_fvs `thenRn` \ (decls, needed) ->
200 -- Then get everything else
201 closeDecls decls needed
204 -------------------------------------------------------
205 slurpSourceRefs :: FreeVars -- Variables referenced in source
206 -> RnMG ([RenamedHsDecl],
207 FreeVars) -- Un-satisfied needs
208 -- The declaration (and hence home module) of each gate has
209 -- already been loaded
211 slurpSourceRefs source_fvs
212 = go_outer [] -- Accumulating decls
213 emptyFVs -- Unsatisfied needs
214 emptyFVs -- Accumulating gates
215 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
217 -- The outer loop repeatedly slurps the decls for the current gates
218 -- and the instance decls
220 -- The outer loop is needed because consider
222 go_outer decls fvs all_gates []
223 = returnRn (decls, fvs)
225 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
226 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
227 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
228 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
229 rnIfaceInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
230 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
231 (nameSetToList (gates2 `minusNameSet` all_gates))
232 -- Knock out the all_gates because even if we don't slurp any new
233 -- decls we can get some apparently-new gates from wired-in names
235 go_inner (decls, fvs, gates) wanted_name
236 = importDecl wanted_name `thenRn` \ import_result ->
237 case import_result of
238 AlreadySlurped -> returnRn (decls, fvs, gates)
239 InTypeEnv ty_thing -> returnRn (decls, fvs, gates `plusFV` getWiredInGates ty_thing)
241 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
242 returnRn (TyClD new_decl : decls,
244 gates `plusFV` getGates source_fvs new_decl)
249 -------------------------------------------------------
250 -- closeDecls keeps going until the free-var set is empty
251 closeDecls decls needed
252 | not (isEmptyFVs needed)
253 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
254 closeDecls decls1 needed1
257 = getImportedRules `thenRn` \ rule_decls ->
259 [] -> returnRn decls -- No new rules, so we are done
260 other -> rnIfaceDecls rnIfaceRuleDecl rule_decls `thenRn` \ rule_decls' ->
262 rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
264 traceRn (text "closeRules" <+> ppr rule_decls' $$ fsep (map ppr (nameSetToList rule_fvs))) `thenRn_`
265 closeDecls (map RuleD rule_decls' ++ decls) rule_fvs
269 -------------------------------------------------------
270 -- Augment decls with any decls needed by needed.
271 -- Return also free vars of the new decls (only)
272 slurpDecls decls needed
273 = go decls emptyFVs (nameSetToList needed)
275 go decls fvs [] = returnRn (decls, fvs)
276 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
279 -------------------------------------------------------
280 slurpDecl decls fvs wanted_name
281 = importDecl wanted_name `thenRn` \ import_result ->
282 case import_result of
283 -- Found a declaration... rename it
284 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
285 returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
287 -- No declaration... (wired in thing, or deferred, or already slurped)
288 other -> returnRn (decls, fvs)
291 -------------------------------------------------------
292 rnIfaceDecls rn decls = mapRn (rnIfaceDecl rn) decls
293 rnIfaceDecl rn (mod, decl) = initIfaceRnMS mod (rn decl)
295 rnIfaceInstDecls decls fvs gates inst_decls
296 = rnIfaceDecls rnInstDecl inst_decls `thenRn` \ inst_decls' ->
297 returnRn (map InstD inst_decls' ++ decls,
298 fvs `plusFV` plusFVs (map instDeclFVs inst_decls'),
299 gates `plusFV` plusFVs (map getInstDeclGates inst_decls'))
301 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl) `thenRn` \ decl' ->
302 returnRn (decl', tyClDeclFVs decl')
307 recordDeclSlurp ifaces@(Ifaces { iDecls = (decls_map, n_slurped),
308 iSlurp = slurped_names,
311 = ASSERT2( not (isLocalName (availName avail)), ppr avail )
312 ifaces { iDecls = (new_decls_map, n_slurped+1),
313 iSlurp = new_slurped_names,
314 iVSlurp = updateVSlurp vslurp (availName avail) }
316 new_decls_map = foldl delFromNameEnv decls_map (availNames avail)
317 new_slurped_names = addAvailToNameSet slurped_names avail
320 -- recordTypeEnvSlurp is used when we slurp something that's
321 -- already in the type environment, that was not slurped in an earlier compilation.
322 -- We record it in the iVSlurp set, because that's used to
323 -- generate usage information
325 recordTypeEnvSlurp ifaces ty_thing
326 = ifaces { iVSlurp = updateVSlurp (iVSlurp ifaces) (get_main_name ty_thing) }
328 -- Tiresomely, we must get the "main" name for the
329 -- thing, because that's what VSlurp contains, and what
330 -- is recorded in the usage information
331 get_main_name (AClass cl) = className cl
332 get_main_name (ATyCon tc)
333 | Just clas <- tyConClass_maybe tc = get_main_name (AClass clas)
334 | otherwise = tyConName tc
335 get_main_name (AnId id)
336 = case globalIdDetails id of
337 DataConId dc -> get_main_name (ATyCon (dataConTyCon dc))
338 DataConWrapId dc -> get_main_name (ATyCon (dataConTyCon dc))
339 RecordSelId lbl -> get_main_name (ATyCon (fieldLabelTyCon lbl))
342 updateVSlurp (imp_mods, imp_names) main_name
343 | isHomeModule mod = (imp_mods, addOneToNameSet imp_names main_name)
344 | otherwise = (extendModuleSet imp_mods mod, imp_names)
346 mod = nameModule main_name
348 recordLocalSlurps new_names
349 = getIfacesRn `thenRn` \ ifaces ->
350 setIfacesRn (ifaces { iSlurp = iSlurp ifaces `unionNameSets` new_names })
355 %*********************************************************
357 \subsection{Extracting the `gates'}
359 %*********************************************************
363 We want to avoid sucking in too many instance declarations.
364 An instance decl is only useful if the types and classes mentioned in
365 its 'head' are all available in the program being compiled. E.g.
367 instance (..) => C (T1 a) (T2 b) where ...
369 is only useful if C, T1 and T2 are all "available". So we keep
370 instance decls that have been parsed from .hi files, but not yet
371 slurped in, in a pool called the 'gated instance pool'.
372 Each has its set of 'gates': {C, T1, T2} in the above example.
374 More precisely, the gates of a module are the types and classes
375 that are mentioned in:
378 b) the type of an Id that's mentioned in the source code
379 [includes constructors and selectors]
380 c) the RHS of a type synonym that is a gate
381 d) the superclasses of a class that is a gate
382 e) the context of an instance decl that is slurped in
384 We slurp in an instance decl from the gated instance pool iff
386 all its gates are either in the gates of the module,
387 or are a previously-loaded class.
389 The latter constraint is because there might have been an instance
390 decl slurped in during an earlier compilation, like this:
392 instance Foo a => Baz (Maybe a) where ...
394 In the module being compiled we might need (Baz (Maybe T)), where T
395 is defined in this module, and hence we need (Foo T). So @Foo@ becomes
396 a gate. But there's no way to 'see' that, so we simply treat all
397 previously-loaded classes as gates.
399 Consructors and class operations
400 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
401 When we import a declaration like
403 data T = T1 Wibble | T2 Wobble
405 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
406 @T1@, @T2@ respectively are mentioned by the user program. If only
407 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
408 in useless instance decls for (say) @Eq Wibble@, when they can't
411 And that's just what (b) says: we only treat T1's type as a gate if
412 T1 is mentioned. getGates, which deals with decls we are slurping in,
413 has to be a bit careful, because a mention of T1 will slurp in T's whole
416 -----------------------------
417 @getGates@ takes a newly imported (and renamed) decl, and the free
418 vars of the source program, and extracts from the decl the gate names.
421 getGates :: FreeVars -- Things mentioned in the source program
425 getGates source_fvs decl
426 = get_gates (\n -> n `elemNameSet` source_fvs) decl
428 get_gates is_used (IfaceSig {tcdType = ty}) = extractHsTyNames ty
430 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
431 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
433 `addOneToNameSet` cls)
434 `plusFV` implicitGates cls
436 get (ClassOpSig n _ ty _)
437 | is_used n = extractHsTyNames ty
438 | otherwise = emptyFVs
440 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
441 = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
442 -- A type synonym type constructor isn't a "gate" for instance decls
444 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
445 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
447 `addOneToNameSet` tycon
449 get (ConDecl n _ tvs ctxt details _)
451 -- If the constructor is method, get fvs from all its fields
452 = delListFromNameSet (get_details details `plusFV`
453 extractHsCtxtTyNames ctxt)
455 get (ConDecl n _ tvs ctxt (RecCon fields) _)
456 -- Even if the constructor isn't mentioned, the fields
457 -- might be, as selectors. They can't mention existentially
458 -- bound tyvars (typechecker checks for that) so no need for
459 -- the deleteListFromNameSet part
460 = foldr (plusFV . get_field) emptyFVs fields
462 get other_con = emptyFVs
464 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
465 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
466 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
468 get_field (fs,t) | any is_used fs = get_bang t
469 | otherwise = emptyFVs
471 get_bang bty = extractHsTyNames (getBangType bty)
474 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
475 thing rather than a declaration.
478 getWiredInGates :: TyThing -> FreeVars
479 -- The TyThing is one that we already have in our type environment, either
480 -- a) because the TyCon or Id is wired in, or
481 -- b) from a previous compile
482 -- Either way, we might have instance decls in the (persistent) collection
483 -- of parsed-but-not-slurped instance decls that should be slurped in.
484 -- This might be the first module that mentions both the type and the class
485 -- for that instance decl, even though both the type and the class were
486 -- mentioned in other modules, and hence are in the type environment
488 getWiredInGates (AnId the_id) = namesOfType (idType the_id)
489 getWiredInGates (AClass cl) = emptyFVs -- The superclasses must also be previously
490 -- loaded, and hence are automatically gates
491 getWiredInGates (ATyCon tc)
492 | isSynTyCon tc = delListFromNameSet (namesOfType ty) (map getName tyvars)
493 | otherwise = unitFV (getName tc)
495 (tyvars,ty) = getSynTyConDefn tc
497 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
501 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameInstDecl)]
502 getImportedInstDecls gates
503 = -- First, load any orphan-instance modules that aren't aready loaded
504 -- Orphan-instance modules are recorded in the module dependecnies
505 getIfacesRn `thenRn` \ ifaces ->
508 [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
510 loadOrphanModules orphan_mods `thenRn_`
512 -- Now we're ready to grab the instance declarations
513 -- Find the un-gated ones and return them,
514 -- removing them from the bag kept in Ifaces
515 getIfacesRn `thenRn` \ ifaces ->
516 getTypeEnvRn `thenRn` \ lookup ->
518 available n = n `elemNameSet` gates
519 || case lookup n of { Just (AClass c) -> True; other -> False }
520 -- See "The gating story" above for the AClass thing
522 (decls, new_insts) = selectGated available (iInsts ifaces)
524 setIfacesRn (ifaces { iInsts = new_insts }) `thenRn_`
526 traceRn (sep [text "getImportedInstDecls:",
527 nest 4 (fsep (map ppr gate_list)),
528 text "Slurped" <+> int (length decls) <+> text "instance declarations",
529 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenRn_`
532 gate_list = nameSetToList gates
534 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
536 HsForAllTy _ _ tau -> ppr tau
539 getImportedRules :: RnMG [(Module,RdrNameRuleDecl)]
541 | opt_IgnoreIfacePragmas = returnRn []
543 = getIfacesRn `thenRn` \ ifaces ->
544 getTypeEnvRn `thenRn` \ lookup ->
546 -- Slurp rules for anything that is slurped,
547 -- either now or previously
548 gates = iSlurp ifaces
549 available n = n `elemNameSet` gates || maybeToBool (lookup n)
550 (decls, new_rules) = selectGated available (iRules ifaces)
555 setIfacesRn (ifaces { iRules = new_rules }) `thenRn_`
556 traceRn (sep [text "getImportedRules:",
557 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenRn_`
560 selectGated :: (Name->Bool) -> GatedDecls d
561 -> ([(Module,d)], GatedDecls d)
562 selectGated available (decl_bag, n_slurped)
563 -- Select only those decls whose gates are *all* available
565 | opt_NoPruneDecls -- Just to try the effect of not gating at all
567 decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag -- Grab them all
569 (decls, (emptyBag, n_slurped + length decls))
573 = case foldrBag select ([], emptyBag) decl_bag of
574 (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
576 select (reqd, decl) (yes, no)
577 | all available reqd = (decl:yes, no)
578 | otherwise = (yes, (reqd,decl) `consBag` no)
582 %*********************************************************
584 \subsection{Getting in a declaration}
586 %*********************************************************
589 importDecl :: Name -> RnMG ImportDeclResult
591 data ImportDeclResult
594 | HereItIs (Module, RdrNameTyClDecl)
597 = -- STEP 1: Check if we've slurped it in while compiling this module
598 getIfacesRn `thenRn` \ ifaces ->
599 if name `elemNameSet` iSlurp ifaces then
600 returnRn AlreadySlurped
604 -- STEP 2: Check if it's already in the type environment
605 getTypeEnvRn `thenRn` \ lookup ->
606 case lookup name of {
608 | name `elemNameEnv` wiredInThingEnv
609 -> -- When we find a wired-in name we must load its home
610 -- module so that we find any instance decls lurking therein
611 loadHomeInterface wi_doc name `thenRn_`
612 returnRn (InTypeEnv ty_thing)
615 -> -- Very important: record that we've seen it
616 -- See comments with recordTypeEnvSlurp
617 setIfacesRn (recordTypeEnvSlurp ifaces ty_thing) `thenRn_`
618 returnRn (InTypeEnv ty_thing) ;
622 -- STEP 3: OK, we have to slurp it in from an interface file
623 -- First load the interface file
624 traceRn nd_doc `thenRn_`
625 loadHomeInterface nd_doc name `thenRn_`
626 getIfacesRn `thenRn` \ ifaces ->
628 -- STEP 4: Get the declaration out
630 (decls_map, _) = iDecls ifaces
632 case lookupNameEnv decls_map name of
633 Just (avail,_,decl) -> setIfacesRn (recordDeclSlurp ifaces avail) `thenRn_`
634 returnRn (HereItIs decl)
636 Nothing -> addErrRn (getDeclErr name) `thenRn_`
637 returnRn AlreadySlurped
640 wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
641 nd_doc = ptext SLIT("need decl for") <+> ppr name
646 %********************************************************
648 \subsection{Checking usage information}
650 %********************************************************
652 @recompileRequired@ is called from the HscMain. It checks whether
653 a recompilation is required. It needs access to the persistent state,
654 finder, etc, because it may have to load lots of interface files to
655 check their versions.
658 type RecompileRequired = Bool
659 upToDate = False -- Recompile not required
660 outOfDate = True -- Recompile required
662 recompileRequired :: FilePath -- Only needed for debug msgs
663 -> ModIface -- Old interface
664 -> RnMG RecompileRequired
665 recompileRequired iface_path iface
666 = traceHiDiffsRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
668 -- Source code unchanged and no errors yet... carry on
669 checkList [checkModUsage u | u <- mi_usages iface]
671 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
672 checkList [] = returnRn upToDate
673 checkList (check:checks) = check `thenRn` \ recompile ->
681 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
682 -- Given the usage information extracted from the old
683 -- M.hi file for the module being compiled, figure out
684 -- whether M needs to be recompiled.
686 checkModUsage (mod_name, _, _, NothingAtAll)
687 -- If CurrentModule.hi contains
689 -- then that simply records that Foo lies below CurrentModule in the
690 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
691 -- In this case we don't even want to open Foo's interface.
692 = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
694 checkModUsage (mod_name, _, is_boot, whats_imported)
695 = -- Load the imported interface is possible
696 -- We use tryLoadInterface, because failure is not an error
697 -- (might just be that the old .hi file for this module is out of date)
698 -- We use ImportByUser/ImportByUserSource as the 'from' flag,
699 -- a) because we need to know whether to load the .hi-boot file
700 -- b) because loadInterface things matters are amiss if we
701 -- ImportBySystem an interface it knows nothing about
703 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
704 from | is_boot = ImportByUserSource
705 | otherwise = ImportByUser
707 traceHiDiffsRn (text "Checking usages for module" <+> ppr mod_name) `thenRn_`
708 tryLoadInterface doc_str mod_name from `thenRn` \ (iface, maybe_err) ->
711 Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
713 -- Couldn't find or parse a module mentioned in the
714 -- old interface file. Don't complain -- it might just be that
715 -- the current module doesn't need that import and it's been deleted
719 new_vers = mi_version iface
720 new_decl_vers = vers_decls new_vers
722 case whats_imported of { -- NothingAtAll dealt with earlier
724 Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
726 out_of_date (ptext SLIT("...and I needed the whole module"))
730 Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
733 checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
734 if not recompile then
739 if checkExportList maybe_old_export_vers new_vers then
740 out_of_date (ptext SLIT("Export list changed"))
744 if old_rule_vers /= vers_rules new_vers then
745 out_of_date (ptext SLIT("Rules changed"))
748 -- CHECK ITEMS ONE BY ONE
749 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenRn` \ recompile ->
751 returnRn outOfDate -- This one failed, so just bail out now
753 up_to_date (ptext SLIT("...but the bits I use haven't."))
757 ------------------------
758 checkModuleVersion old_mod_vers new_vers
759 | vers_module new_vers == old_mod_vers
760 = up_to_date (ptext SLIT("Module version unchanged"))
763 = out_of_date (ptext SLIT("Module version has changed"))
765 ------------------------
766 checkExportList Nothing new_vers = upToDate
767 checkExportList (Just v) new_vers = v /= vers_exports new_vers
769 ------------------------
770 checkEntityUsage new_vers (name,old_vers)
771 = case lookupNameEnv new_vers name of
773 Nothing -> -- We used it before, but it ain't there now
774 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
776 Just new_vers -- It's there, but is it up to date?
777 | new_vers == old_vers -> traceHiDiffsRn (text "Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenRn_` returnRn upToDate
778 | otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
780 up_to_date msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
781 out_of_date msg = traceHiDiffsRn msg `thenRn_` returnRn outOfDate
785 %*********************************************************
789 %*********************************************************
793 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
794 ptext SLIT("from module") <+> quotes (ppr (nameModule name))