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 ( RdrNameHsDecl, RdrNameTyClDecl, RdrNameInstDecl )
28 import RnHsSyn ( RenamedHsDecl, extractHsTyNames, extractHsCtxtTyNames, tyClDeclFVs )
29 import RnHiFiles ( tryLoadInterface, loadHomeInterface, loadInterface,
32 import RnSource ( rnTyClDecl, rnDecl )
36 import DataCon ( classDataCon, dataConId )
37 import Type ( namesOfType )
38 import TyCon ( isSynTyCon, getSynTyConDefn )
39 import Name ( Name {-instance NamedThing-}, nameOccName,
40 nameModule, isLocalName, nameUnique,
43 import Name ( elemNameEnv )
44 import Module ( Module, ModuleEnv,
45 moduleName, isModuleInThisPackage,
46 ModuleName, WhereFrom(..),
48 extendModuleEnv_C, foldModuleEnv, lookupModuleEnv,
49 elemModuleSet, extendModuleSet
52 import PrelInfo ( wiredInThingEnv, fractionalClassKeys )
53 import TysWiredIn ( doubleTyCon )
54 import Maybes ( orElse )
58 import Util ( sortLt )
62 %*********************************************************
64 \subsection{Getting what a module exports}
66 %*********************************************************
68 @getInterfaceExports@ is called only for directly-imported modules.
71 getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, [(ModuleName,Avails)])
72 getInterfaceExports mod_name from
73 = loadInterface doc_str mod_name from `thenRn` \ iface ->
74 returnRn (mi_module iface, mi_exports iface)
76 doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")]
80 %*********************************************************
82 \subsection{Keeping track of what we've slurped, and version numbers}
84 %*********************************************************
86 getImportVersions figures out what the ``usage information'' for this
87 moudule is; that is, what it must record in its interface file as the
88 things it uses. It records:
91 \item (a) anything reachable from its body code
92 \item (b) any module exported with a @module Foo@
93 \item (c) anything reachable from an exported item
96 Why (b)? Because if @Foo@ changes then this module's export list
97 will change, so we must recompile this module at least as far as
98 making a new interface file --- but in practice that means complete
101 Why (c)? Consider this:
103 module A( f, g ) where | module B( f ) where
104 import B( f ) | f = h 3
108 Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in
109 @A@'s usages? Our idea is that we aren't going to touch A.hi if it is
110 *identical* to what it was before. If anything about @B.f@ changes
111 than anyone who imports @A@ should be recompiled in case they use
112 @B.f@ (they'll get an early exit if they don't). So, if anything
113 about @B.f@ changes we'd better make sure that something in A.hi
114 changes, and the convenient way to do that is to record the version
115 number @B.f@ in A.hi in the usage list. If B.f changes that'll force a
116 complete recompiation of A, which is overkill but it's the only way to
117 write a new, slightly different, A.hi.
119 But the example is tricker. Even if @B.f@ doesn't change at all,
120 @B.h@ may do so, and this change may not be reflected in @f@'s version
121 number. But with -O, a module that imports A must be recompiled if
122 @B.h@ changes! So A must record a dependency on @B.h@. So we treat
123 the occurrence of @B.f@ in the export list *just as if* it were in the
124 code of A, and thereby haul in all the stuff reachable from it.
126 [NB: If B was compiled with -O, but A isn't, we should really *still*
127 haul in all the unfoldings for B, in case the module that imports A *is*
128 compiled with -O. I think this is the case.]
130 Even if B is used at all we get a usage line for B
131 import B <n> :: ... ;
132 in A.hi, to record the fact that A does import B. This is used to decide
133 to look to look for B.hi rather than B.hi-boot when compiling a module that
134 imports A. This line says that A imports B, but uses nothing in it.
135 So we'll get an early bale-out when compiling A if B's version changes.
138 mkImportInfo :: ModuleName -- Name of this module
139 -> [ImportDecl n] -- The import decls
140 -> RnMG [ImportVersion Name]
142 mkImportInfo this_mod imports
143 = getIfacesRn `thenRn` \ ifaces ->
144 getHomeIfaceTableRn `thenRn` \ hit ->
146 (imp_pkg_mods, imp_home_names) = iVSlurp ifaces
149 import_all_mods :: [ModuleName]
150 -- Modules where we imported all the names
151 -- (apart from hiding some, perhaps)
152 import_all_mods = [ m | ImportDecl m _ _ _ imp_list _ <- imports,
153 import_all imp_list ]
155 import_all (Just (False, _)) = False -- Imports are specified explicitly
156 import_all other = True -- Everything is imported
158 -- mv_map groups together all the things imported and used
159 -- from a particular module in this package
160 -- We use a finite map because we want the domain
161 mv_map :: ModuleEnv [Name]
162 mv_map = foldNameSet add_mv emptyModuleEnv imp_home_names
163 add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
165 mod = nameModule name
166 add_item names _ = name:names
168 -- In our usage list we record
169 -- a) Specifically: Detailed version info for imports from modules in this package
170 -- Gotten from iVSlurp plus import_all_mods
172 -- b) Everything: Just the module version for imports from modules in other packages
173 -- Gotten from iVSlurp plus import_all_mods
175 -- c) NothingAtAll: The name only of modules, Baz, in this package that are 'below' us,
176 -- but which we didn't need at all (this is needed only to decide whether
177 -- to open Baz.hi or Baz.hi-boot higher up the tree).
178 -- This happens when a module, Foo, that we explicitly imported has
179 -- 'import Baz' in its interface file, recording that Baz is below
180 -- Foo in the module dependency hierarchy. We want to propagate this info.
181 -- These modules are in a combination of HIT/PIT and iImpModInfo
183 -- d) NothingAtAll: The name only of all orphan modules we know of (this is needed
184 -- so that anyone who imports us can find the orphan modules)
185 -- These modules are in a combination of HIT/PIT and iImpModInfo
187 import_info0 = foldModuleEnv mk_imp_info [] pit
188 import_info1 = foldModuleEnv mk_imp_info import_info0 hit
189 import_info = [ (mod_name, orphans, is_boot, NothingAtAll)
190 | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ] ++
193 mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
194 mk_imp_info iface so_far
196 | Just ns <- lookupModuleEnv mv_map mod -- Case (a)
197 = go_for_it (Specifically mod_vers maybe_export_vers
198 (mk_import_items ns) rules_vers)
200 | mod `elemModuleSet` imp_pkg_mods -- Case (b)
201 = go_for_it (Everything mod_vers)
203 | import_all_mod -- Case (a) and (b); the import-all part
204 = if is_home_pkg_mod then
205 go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
207 go_for_it (Everything mod_vers)
209 | is_home_pkg_mod || has_orphans -- Case (c) or (d)
210 = go_for_it NothingAtAll
214 go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
216 mod = mi_module iface
217 mod_name = moduleName mod
218 is_home_pkg_mod = isModuleInThisPackage mod
219 version_info = mi_version iface
220 version_env = vers_decls version_info
221 mod_vers = vers_module version_info
222 rules_vers = vers_rules version_info
223 export_vers = vers_exports version_info
224 import_all_mod = mod_name `elem` import_all_mods
225 has_orphans = mi_orphan iface
227 -- The sort is to put them into canonical order
228 mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
229 let v = lookupNameEnv version_env n `orElse`
230 pprPanic "mk_whats_imported" (ppr n)
233 lt_occ n1 n2 = nameOccName n1 < nameOccName n2
235 maybe_export_vers | import_all_mod = Just (vers_exports version_info)
236 | otherwise = Nothing
241 %*********************************************************
243 \subsection{Slurping declarations}
245 %*********************************************************
248 -------------------------------------------------------
249 slurpImpDecls source_fvs
250 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
252 -- The current slurped-set records all local things
253 getSlurped `thenRn` \ source_binders ->
254 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
256 -- Then get everything else
257 closeDecls decls needed `thenRn` \ decls1 ->
259 -- Finally, get any deferred data type decls
260 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
265 -------------------------------------------------------
266 slurpSourceRefs :: NameSet -- Variables defined in source
267 -> FreeVars -- Variables referenced in source
268 -> RnMG ([RenamedHsDecl],
269 FreeVars) -- Un-satisfied needs
270 -- The declaration (and hence home module) of each gate has
271 -- already been loaded
273 slurpSourceRefs source_binders source_fvs
274 = go_outer [] -- Accumulating decls
275 emptyFVs -- Unsatisfied needs
276 emptyFVs -- Accumulating gates
277 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
279 -- The outer loop repeatedly slurps the decls for the current gates
280 -- and the instance decls
282 -- The outer loop is needed because consider
283 -- instance Foo a => Baz (Maybe a) where ...
284 -- It may be that @Baz@ and @Maybe@ are used in the source module,
285 -- but not @Foo@; so we need to chase @Foo@ too.
287 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
288 -- include actually getting in Foo's class decl
289 -- class Wib a => Foo a where ..
290 -- so that its superclasses are discovered. The point is that Wib is a gate too.
291 -- We do this for tycons too, so that we look through type synonyms.
293 go_outer decls fvs all_gates []
294 = returnRn (decls, fvs)
296 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
297 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
298 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
299 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
300 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
301 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
302 (nameSetToList (gates2 `minusNameSet` all_gates))
303 -- Knock out the all_gates because even if we don't slurp any new
304 -- decls we can get some apparently-new gates from wired-in names
306 go_inner (decls, fvs, gates) wanted_name
307 = importDecl wanted_name `thenRn` \ import_result ->
308 case import_result of
309 AlreadySlurped -> returnRn (decls, fvs, gates)
310 InTypeEnv ty_thing -> returnRn (decls, fvs, gates `plusFV` getWiredInGates ty_thing)
311 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
313 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
314 returnRn (TyClD new_decl : decls,
316 gates `plusFV` getGates source_fvs new_decl)
318 rnInstDecls decls fvs gates []
319 = returnRn (decls, fvs, gates)
320 rnInstDecls decls fvs gates (d:ds)
321 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
322 rnInstDecls (new_decl:decls)
324 (gates `plusFV` getInstDeclGates new_decl)
330 -------------------------------------------------------
331 -- closeDecls keeps going until the free-var set is empty
332 closeDecls decls needed
333 | not (isEmptyFVs needed)
334 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
335 closeDecls decls1 needed1
338 = getImportedRules `thenRn` \ rule_decls ->
340 [] -> returnRn decls -- No new rules, so we are done
341 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
342 closeDecls decls1 needed1
345 -------------------------------------------------------
346 -- Augment decls with any decls needed by needed.
347 -- Return also free vars of the new decls (only)
348 slurpDecls decls needed
349 = go decls emptyFVs (nameSetToList needed)
351 go decls fvs [] = returnRn (decls, fvs)
352 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
355 -------------------------------------------------------
356 slurpDecl decls fvs wanted_name
357 = importDecl wanted_name `thenRn` \ import_result ->
358 case import_result of
359 -- Found a declaration... rename it
360 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
361 returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
363 -- No declaration... (wired in thing, or deferred, or already slurped)
364 other -> returnRn (decls, fvs)
367 -------------------------------------------------------
368 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
369 -> [(Module, RdrNameHsDecl)]
370 -> RnM d ([RenamedHsDecl], FreeVars)
371 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
372 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
373 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
375 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
376 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl) `thenRn` \ decl' ->
377 returnRn (decl', tyClDeclFVs decl')
383 = getIfacesRn `thenRn` \ ifaces ->
384 returnRn (iSlurp ifaces)
386 recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = (imp_mods, imp_names) })
388 = ASSERT2( not (isLocalName (availName avail)), ppr avail )
389 ifaces { iSlurp = new_slurped_names, iVSlurp = new_vslurp }
391 main_name = availName avail
392 mod = nameModule main_name
393 new_slurped_names = addAvailToNameSet slurped_names avail
394 new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names main_name)
395 | otherwise = (extendModuleSet imp_mods mod, imp_names)
397 recordLocalSlurps local_avails
398 = getIfacesRn `thenRn` \ ifaces ->
400 new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
402 setIfacesRn (ifaces { iSlurp = new_slurped_names })
407 %*********************************************************
409 \subsection{Deferred declarations}
411 %*********************************************************
413 The idea of deferred declarations is this. Suppose we have a function
418 Then we don't want to load T and all its constructors, and all
419 the types those constructors refer to, and all the types *those*
420 constructors refer to, and so on. That might mean loading many more
421 interface files than is really necessary. So we 'defer' loading T.
423 But f might be strict, and the calling convention for evaluating
424 values of type T depends on how many constructors T has, so
425 we do need to load T, but not the full details of the type T.
426 So we load the full decl for T, but only skeleton decls for A and B:
428 data T = {- 2 constructors -}
430 Whether all this is worth it is moot.
433 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
434 slurpDeferredDecls decls = returnRn decls
437 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
438 slurpDeferredDecls decls
439 = getDeferredDecls `thenRn` \ def_decls ->
440 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
441 ASSERT( isEmptyFVs fvs )
444 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ loc name1 name2))
445 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing loc
447 -- Nuke the context and constructors
448 -- But retain the *number* of constructors!
449 -- Also the tvs will have kinds on them.
454 %*********************************************************
456 \subsection{Extracting the `gates'}
458 %*********************************************************
462 We want to avoid sucking in too many instance declarations.
463 An instance decl is only useful if the types and classes mentioned in
464 its 'head' are all available in the program being compiled. E.g.
466 instance (..) => C (T1 a) (T2 b) where ...
468 is only useful if C, T1 and T2 are all available. So we keep
469 instance decls that have been parsed from .hi files, but not yet
470 slurped in, in a pool called the 'gated instance pool'.
471 Each has its set of 'gates': {C, T1, T2} in the above example.
475 *All* the instances whose gates are entirely in the stuff that's
476 already been through the type checker (i.e. are already in the
477 Persistent Type Environment or Home Symbol Table) have already been
478 slurped in, and are no longer in the gated instance pool.
480 Hence, when we read a new module, we see what new gates we have,
481 and let in any instance decls whose gates are
482 either in the new gates,
485 An earlier optimisation: now infeasible
486 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
487 When we import a declaration like
489 data T = T1 Wibble | T2 Wobble
491 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
492 @T1@, @T2@ respectively are mentioned by the user program. If only
493 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
494 in useless instance decls for (say) @Eq Wibble@, when they can't
497 BUT, I can't see how to do this and still maintain the GATING INVARIANT.
498 So I've simply ditched the optimisation to get things working.
503 @getGates@ takes a newly imported (and renamed) decl, and the free
504 vars of the source program, and extracts from the decl the gate names.
507 getGates :: FreeVars -- Things mentioned in the source program
511 get_gates source_fvs decl = get_gates (\n -> True) decl
512 -- We'd use (\n -> n `elemNameSet` source_fvs)
513 -- if we were using the 'earlier optimisation above
515 get_gates is_used (IfaceSig _ ty _ _)
516 = extractHsTyNames ty
518 get_gates is_used (ClassDecl ctxt cls tvs _ sigs _ _ _ )
519 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
521 `addOneToNameSet` cls)
522 `plusFV` maybe_double
524 get (ClassOpSig n _ ty _)
525 | is_used n = extractHsTyNames ty
526 | otherwise = emptyFVs
528 -- If we load any numeric class that doesn't have
529 -- Int as an instance, add Double to the gates.
530 -- This takes account of the fact that Double might be needed for
531 -- defaulting, but we don't want to load Double (and all its baggage)
532 -- if the more exotic classes aren't used at all.
533 maybe_double | nameUnique cls `elem` fractionalClassKeys
534 = unitFV (getName doubleTyCon)
538 get_gates is_used (TySynonym tycon tvs ty _)
539 = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
540 -- A type synonym type constructor isn't a "gate" for instance decls
542 get_gates is_used (TyData _ ctxt tycon tvs cons _ _ _ _ _)
543 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
545 `addOneToNameSet` tycon
547 get (ConDecl n _ tvs ctxt details _)
549 -- If the constructor is method, get fvs from all its fields
550 = delListFromNameSet (get_details details `plusFV`
551 extractHsCtxtTyNames ctxt)
553 get (ConDecl n _ tvs ctxt (RecCon fields) _)
554 -- Even if the constructor isn't mentioned, the fields
555 -- might be, as selectors. They can't mention existentially
556 -- bound tyvars (typechecker checks for that) so no need for
557 -- the deleteListFromNameSet part
558 = foldr (plusFV . get_field) emptyFVs fields
560 get other_con = emptyFVs
562 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
563 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
564 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
566 get_field (fs,t) | any is_used fs = get_bang t
567 | otherwise = emptyFVs
569 get_bang bty = extractHsTyNames (getBangType bty)
572 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
573 rather than a declaration.
576 getWiredInGates :: TyThing -> FreeVars
577 -- The TyThing is one that we already have in our type environment, either
578 -- a) because the TyCon or Id is wired in, or
579 -- b) from a previous compile
580 -- Either way, we might have instance decls in the (persistend) collection
581 -- of parsed-but-not-slurped instance decls that should be slurped in.
582 -- This might be the first module that mentions both the type and the class
583 -- for that instance decl, even though both the type and the class were
584 -- mentioned in other modules, and hence are in the type environment
586 getWiredInGates (AnId the_id) = getWiredInGates_s (namesOfType (idType the_id))
587 getWiredInGates (AClass cl) = namesOfType (idType (dataConId (classDataCon cl))) -- Cunning
588 getWiredInGates (ATyCon tc)
589 | isSynTyCon tc = getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
590 | otherwise = unitFV (getName tc)
592 (tyvars,ty) = getSynTyConDefn tc
594 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
598 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
599 getInstDeclGates other = emptyFVs
603 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
604 getImportedInstDecls gates
605 = -- First, load any orphan-instance modules that aren't aready loaded
606 -- Orphan-instance modules are recorded in the module dependecnies
607 getIfacesRn `thenRn` \ ifaces ->
610 [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
612 loadOrphanModules orphan_mods `thenRn_`
614 -- Now we're ready to grab the instance declarations
615 -- Find the un-gated ones and return them,
616 -- removing them from the bag kept in Ifaces
617 getIfacesRn `thenRn` \ ifaces ->
618 getTypeEnvRn `thenRn` \ lookup ->
620 (decls, new_insts) = selectGated gates lookup (iInsts ifaces)
622 setIfacesRn (ifaces { iInsts = new_insts }) `thenRn_`
624 traceRn (sep [text "getImportedInstDecls:",
625 nest 4 (fsep (map ppr gate_list)),
626 text "Slurped" <+> int (length decls) <+> text "instance declarations",
627 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenRn_`
630 gate_list = nameSetToList gates
632 ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
634 HsForAllTy _ _ tau -> ppr tau
637 getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
639 | opt_IgnoreIfacePragmas = returnRn []
641 = getIfacesRn `thenRn` \ ifaces ->
642 getTypeEnvRn `thenRn` \ lookup ->
644 gates = iSlurp ifaces -- Anything at all that's been slurped
645 rules = iRules ifaces
646 (decls, new_rules) = selectGated gates lookup rules
651 setIfacesRn (ifaces { iRules = new_rules }) `thenRn_`
652 traceRn (sep [text "getImportedRules:",
653 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenRn_`
656 selectGated gates lookup decl_bag
657 -- Select only those decls whose gates are *all* in 'gates'
658 -- or are in the range of lookup
660 | opt_NoPruneDecls -- Just to try the effect of not gating at all
661 = (foldrBag (\ (_,d) ds -> d:ds) [] decl_bag, emptyBag) -- Grab them all
665 = foldrBag select ([], emptyBag) decl_bag
667 available n = n `elemNameSet` gates || maybeToBool (lookup n)
668 select (reqd, decl) (yes, no)
669 | all available reqd = (decl:yes, no)
670 | otherwise = (yes, (reqd,decl) `consBag` no)
674 %*********************************************************
676 \subsection{Getting in a declaration}
678 %*********************************************************
681 importDecl :: Name -> RnMG ImportDeclResult
683 data ImportDeclResult
687 | HereItIs (Module, RdrNameTyClDecl)
690 = -- STEP 1: Check if it was loaded before beginning this module
691 if isLocalName name then
692 traceRn (text "Already (local)" <+> ppr name) `thenRn_`
693 returnRn AlreadySlurped
696 -- STEP 2: Check if it's already in the type environment
697 getTypeEnvRn `thenRn` \ lookup ->
698 case lookup name of {
699 Just ty_thing | name `elemNameEnv` wiredInThingEnv
700 -> -- When we find a wired-in name we must load its home
701 -- module so that we find any instance decls lurking therein
702 loadHomeInterface wi_doc name `thenRn_`
703 returnRn (InTypeEnv (getWiredInGates ty_thing))
706 -> returnRn (InTypeEnv ty_thing) ;
710 -- STEP 3: Check if we've slurped it in while compiling this module
711 getIfacesRn `thenRn` \ ifaces ->
712 if name `elemNameSet` iSlurp ifaces then
713 returnRn AlreadySlurped
716 -- STEP 4: OK, we have to slurp it in from an interface file
717 -- First load the interface file
718 traceRn nd_doc `thenRn_`
719 loadHomeInterface nd_doc name `thenRn_`
720 getIfacesRn `thenRn` \ ifaces ->
722 -- STEP 5: Get the declaration out
723 case lookupNameEnv (iDecls ifaces) name of
725 -> setIfacesRn (recordSlurp ifaces avail) `thenRn_`
726 returnRn (HereItIs decl)
729 -> addErrRn (getDeclErr name) `thenRn_`
730 returnRn AlreadySlurped
733 wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
734 nd_doc = ptext SLIT("need decl for") <+> ppr name
737 {- OMIT DEFERRED STUFF FOR NOW, TILL GHCI WORKS
738 Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _ _)))
739 -- This case deals with deferred import of algebraic data types
741 | not opt_NoPruneTyDecls
743 && (opt_IgnoreIfacePragmas || ncons > 1)
744 -- We only defer if imported interface pragmas are ingored
745 -- or if it's not a product type.
746 -- Sole reason: The wrapper for a strict function may need to look
747 -- inside its arg, and hence need to see its arg type's constructors.
749 && not (getUnique tycon_name `elem` cCallishTyKeys)
750 -- Never defer ccall types; we have to unbox them,
751 -- and importing them does no harm
754 -> -- OK, so we're importing a deferrable data type
755 if needed_name == tycon_name
756 -- The needed_name is the TyCon of a data type decl
757 -- Record that it's slurped, put it in the deferred set
758 -- and don't return a declaration at all
759 setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces
760 `addOneToNameSet` tycon_name})
761 version (AvailTC needed_name [needed_name])) `thenRn_`
765 -- The needed name is a constructor of a data type decl,
766 -- getting a constructor, so remove the TyCon from the deferred set
767 -- (if it's there) and return the full declaration
768 setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces
769 `delFromNameSet` tycon_name})
770 version avail) `thenRn_`
771 returnRn (HereItIs decl)
773 tycon_name = availName avail
777 getDeferredDecls :: RnMG [(Module, RdrNameHsDecl)]
779 = getIfacesRn `thenRn` \ ifaces ->
781 decls_map = iDecls ifaces
782 deferred_names = nameSetToList (iDeferred ifaces)
783 get_abstract_decl n = case lookupNameEnv decls_map n of
784 Just (_, _, _, decl) -> decl
786 traceRn (sep [text "getDeferredDecls", nest 4 (fsep (map ppr deferred_names))]) `thenRn_`
787 returnRn (map get_abstract_decl deferred_names)
791 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
792 It behaves exactly as if the wired in decl were actually in an interface file.
795 \item if the wired-in name is a data type constructor or a data constructor,
796 it brings in the type constructor and all the data constructors; and
797 marks as ``occurrences'' any free vars of the data con.
799 \item similarly for synonum type constructor
801 \item if the wired-in name is another wired-in Id, it marks as ``occurrences''
802 the free vars of the Id's type.
804 \item it loads the interface file for the wired-in thing for the
805 sole purpose of making sure that its instance declarations are available
807 All this is necessary so that we know all types that are ``in play'', so
808 that we know just what instances to bring into scope.
811 %********************************************************
813 \subsection{Checking usage information}
815 %********************************************************
817 @recompileRequired@ is called from the HscMain. It checks whether
818 a recompilation is required. It needs access to the persistent state,
819 finder, etc, because it may have to load lots of interface files to
820 check their versions.
823 type RecompileRequired = Bool
824 upToDate = False -- Recompile not required
825 outOfDate = True -- Recompile required
827 recompileRequired :: FilePath -- Only needed for debug msgs
828 -> Bool -- Source unchanged
829 -> ModIface -- Old interface
830 -> RnMG RecompileRequired
831 recompileRequired iface_path source_unchanged iface
832 = traceRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
834 -- CHECK WHETHER THE SOURCE HAS CHANGED
835 if not source_unchanged then
836 traceRn (nest 4 (text "Source file changed or recompilation check turned off")) `thenRn_`
840 -- Source code unchanged and no errors yet... carry on
841 checkList [checkModUsage u | u <- mi_usages iface]
843 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
844 checkList [] = returnRn upToDate
845 checkList (check:checks) = check `thenRn` \ recompile ->
853 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
854 -- Given the usage information extracted from the old
855 -- M.hi file for the module being compiled, figure out
856 -- whether M needs to be recompiled.
858 checkModUsage (mod_name, _, _, NothingAtAll)
859 -- If CurrentModule.hi contains
861 -- then that simply records that Foo lies below CurrentModule in the
862 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
863 -- In this case we don't even want to open Foo's interface.
864 = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
866 checkModUsage (mod_name, _, _, whats_imported)
867 = tryLoadInterface doc_str mod_name ImportBySystem `thenRn` \ (iface, maybe_err) ->
869 Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
871 -- Couldn't find or parse a module mentioned in the
872 -- old interface file. Don't complain -- it might just be that
873 -- the current module doesn't need that import and it's been deleted
877 new_vers = mi_version iface
878 new_decl_vers = vers_decls new_vers
880 case whats_imported of { -- NothingAtAll dealt with earlier
882 Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
884 out_of_date (ptext SLIT("...and I needed the whole module"))
888 Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
891 checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
892 if not recompile then
897 if checkExportList maybe_old_export_vers new_vers then
898 out_of_date (ptext SLIT("Export list changed"))
902 if old_rule_vers /= vers_rules new_vers then
903 out_of_date (ptext SLIT("Rules changed"))
906 -- CHECK ITEMS ONE BY ONE
907 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenRn` \ recompile ->
909 returnRn outOfDate -- This one failed, so just bail out now
911 up_to_date (ptext SLIT("...but the bits I use haven't."))
915 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
917 ------------------------
918 checkModuleVersion old_mod_vers new_vers
919 | vers_module new_vers == old_mod_vers
920 = up_to_date (ptext SLIT("Module version unchanged"))
923 = out_of_date (ptext SLIT("Module version has changed"))
925 ------------------------
926 checkExportList Nothing new_vers = upToDate
927 checkExportList (Just v) new_vers = v /= vers_exports new_vers
929 ------------------------
930 checkEntityUsage new_vers (name,old_vers)
931 = case lookupNameEnv new_vers name of
933 Nothing -> -- We used it before, but it ain't there now
934 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
936 Just new_vers -- It's there, but is it up to date?
937 | new_vers == old_vers -> returnRn upToDate
938 | otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
940 up_to_date msg = traceRn msg `thenRn_` returnRn upToDate
941 out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate
945 %*********************************************************
949 %*********************************************************
953 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
954 ptext SLIT("from module") <+> quotes (ppr (nameModule name))