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 Type ( namesOfType )
37 import TyCon ( isSynTyCon, getSynTyConDefn )
38 import Name ( Name {-instance NamedThing-}, nameOccName,
39 nameModule, isLocallyDefined, nameUnique,
43 import Module ( Module, ModuleEnv,
44 moduleName, isModuleInThisPackage,
45 ModuleName, WhereFrom(..),
47 extendModuleEnv_C, foldModuleEnv, lookupModuleEnv,
48 elemModuleSet, extendModuleSet
51 import PrelInfo ( wiredInThingEnv, fractionalClassKeys )
52 import TysWiredIn ( doubleTyCon )
53 import Maybes ( orElse )
57 import Util ( sortLt )
61 %*********************************************************
63 \subsection{Getting what a module exports}
65 %*********************************************************
67 @getInterfaceExports@ is called only for directly-imported modules.
70 getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, [(ModuleName,Avails)])
71 getInterfaceExports mod_name from
72 = loadInterface doc_str mod_name from `thenRn` \ iface ->
73 returnRn (mi_module iface, mi_exports iface)
75 doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")]
79 %*********************************************************
81 \subsection{Instance declarations are handled specially}
83 %*********************************************************
86 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
87 getImportedInstDecls gates
88 = -- First, load any orphan-instance modules that aren't aready loaded
89 -- Orphan-instance modules are recorded in the module dependecnies
90 getIfacesRn `thenRn` \ ifaces ->
93 [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
95 loadOrphanModules orphan_mods `thenRn_`
97 -- Now we're ready to grab the instance declarations
98 -- Find the un-gated ones and return them,
99 -- removing them from the bag kept in Ifaces
100 getIfacesRn `thenRn` \ ifaces ->
102 (decls, new_insts) = selectGated gates (iInsts ifaces)
104 setIfacesRn (ifaces { iInsts = new_insts }) `thenRn_`
106 traceRn (sep [text "getImportedInstDecls:",
107 nest 4 (fsep (map ppr gate_list)),
108 text "Slurped" <+> int (length decls) <+> text "instance declarations",
109 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenRn_`
112 gate_list = nameSetToList gates
114 ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
116 HsForAllTy _ _ tau -> ppr tau
119 getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
121 | opt_IgnoreIfacePragmas = returnRn []
123 = getIfacesRn `thenRn` \ ifaces ->
125 gates = iSlurp ifaces -- Anything at all that's been slurped
126 rules = iRules ifaces
127 (decls, new_rules) = selectGated gates rules
132 setIfacesRn (ifaces { iRules = new_rules }) `thenRn_`
133 traceRn (sep [text "getImportedRules:",
134 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenRn_`
137 selectGated gates decl_bag
138 -- Select only those decls whose gates are *all* in 'gates'
140 | opt_NoPruneDecls -- Just to try the effect of not gating at all
141 = (foldrBag (\ (_,d) ds -> d:ds) [] decl_bag, emptyBag) -- Grab them all
145 = foldrBag select ([], emptyBag) decl_bag
147 select (reqd, decl) (yes, no)
148 | isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
149 | otherwise = (yes, (reqd,decl) `consBag` no)
153 %*********************************************************
155 \subsection{Keeping track of what we've slurped, and version numbers}
157 %*********************************************************
159 getImportVersions figures out what the ``usage information'' for this
160 moudule is; that is, what it must record in its interface file as the
161 things it uses. It records:
164 \item (a) anything reachable from its body code
165 \item (b) any module exported with a @module Foo@
166 \item (c) anything reachable from an exported item
169 Why (b)? Because if @Foo@ changes then this module's export list
170 will change, so we must recompile this module at least as far as
171 making a new interface file --- but in practice that means complete
174 Why (c)? Consider this:
176 module A( f, g ) where | module B( f ) where
177 import B( f ) | f = h 3
181 Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in
182 @A@'s usages? Our idea is that we aren't going to touch A.hi if it is
183 *identical* to what it was before. If anything about @B.f@ changes
184 than anyone who imports @A@ should be recompiled in case they use
185 @B.f@ (they'll get an early exit if they don't). So, if anything
186 about @B.f@ changes we'd better make sure that something in A.hi
187 changes, and the convenient way to do that is to record the version
188 number @B.f@ in A.hi in the usage list. If B.f changes that'll force a
189 complete recompiation of A, which is overkill but it's the only way to
190 write a new, slightly different, A.hi.
192 But the example is tricker. Even if @B.f@ doesn't change at all,
193 @B.h@ may do so, and this change may not be reflected in @f@'s version
194 number. But with -O, a module that imports A must be recompiled if
195 @B.h@ changes! So A must record a dependency on @B.h@. So we treat
196 the occurrence of @B.f@ in the export list *just as if* it were in the
197 code of A, and thereby haul in all the stuff reachable from it.
199 [NB: If B was compiled with -O, but A isn't, we should really *still*
200 haul in all the unfoldings for B, in case the module that imports A *is*
201 compiled with -O. I think this is the case.]
203 Even if B is used at all we get a usage line for B
204 import B <n> :: ... ;
205 in A.hi, to record the fact that A does import B. This is used to decide
206 to look to look for B.hi rather than B.hi-boot when compiling a module that
207 imports A. This line says that A imports B, but uses nothing in it.
208 So we'll get an early bale-out when compiling A if B's version changes.
211 mkImportInfo :: ModuleName -- Name of this module
212 -> [ImportDecl n] -- The import decls
213 -> RnMG [ImportVersion Name]
215 mkImportInfo this_mod imports
216 = getIfacesRn `thenRn` \ ifaces ->
217 getHomeIfaceTableRn `thenRn` \ hit ->
219 (imp_pkg_mods, imp_home_names) = iVSlurp ifaces
222 import_all_mods :: [ModuleName]
223 -- Modules where we imported all the names
224 -- (apart from hiding some, perhaps)
225 import_all_mods = [ m | ImportDecl m _ _ _ imp_list _ <- imports,
226 import_all imp_list ]
228 import_all (Just (False, _)) = False -- Imports are specified explicitly
229 import_all other = True -- Everything is imported
231 -- mv_map groups together all the things imported and used
232 -- from a particular module in this package
233 -- We use a finite map because we want the domain
234 mv_map :: ModuleEnv [Name]
235 mv_map = foldNameSet add_mv emptyModuleEnv imp_home_names
236 add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
238 mod = nameModule name
239 add_item names _ = name:names
241 -- In our usage list we record
242 -- a) Specifically: Detailed version info for imports from modules in this package
243 -- Gotten from iVSlurp plus import_all_mods
245 -- b) Everything: Just the module version for imports from modules in other packages
246 -- Gotten from iVSlurp plus import_all_mods
248 -- c) NothingAtAll: The name only of modules, Baz, in this package that are 'below' us,
249 -- but which we didn't need at all (this is needed only to decide whether
250 -- to open Baz.hi or Baz.hi-boot higher up the tree).
251 -- This happens when a module, Foo, that we explicitly imported has
252 -- 'import Baz' in its interface file, recording that Baz is below
253 -- Foo in the module dependency hierarchy. We want to propagate this info.
254 -- These modules are in a combination of HIT/PIT and iImpModInfo
256 -- d) NothingAtAll: The name only of all orphan modules we know of (this is needed
257 -- so that anyone who imports us can find the orphan modules)
258 -- These modules are in a combination of HIT/PIT and iImpModInfo
260 import_info0 = foldModuleEnv mk_imp_info [] pit
261 import_info1 = foldModuleEnv mk_imp_info import_info0 hit
262 import_info = [ (mod_name, orphans, is_boot, NothingAtAll)
263 | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ] ++
266 mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
267 mk_imp_info iface so_far
269 | Just ns <- lookupModuleEnv mv_map mod -- Case (a)
270 = go_for_it (Specifically mod_vers maybe_export_vers
271 (mk_import_items ns) rules_vers)
273 | mod `elemModuleSet` imp_pkg_mods -- Case (b)
274 = go_for_it (Everything mod_vers)
276 | import_all_mod -- Case (a) and (b); the import-all part
277 = if is_home_pkg_mod then
278 go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
280 go_for_it (Everything mod_vers)
282 | is_home_pkg_mod || has_orphans -- Case (c) or (d)
283 = go_for_it NothingAtAll
287 go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
289 mod = mi_module iface
290 mod_name = moduleName mod
291 is_home_pkg_mod = isModuleInThisPackage mod
292 version_info = mi_version iface
293 version_env = vers_decls version_info
294 mod_vers = vers_module version_info
295 rules_vers = vers_rules version_info
296 export_vers = vers_exports version_info
297 import_all_mod = mod_name `elem` import_all_mods
298 has_orphans = mi_orphan iface
300 -- The sort is to put them into canonical order
301 mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns,
302 let v = lookupNameEnv version_env n `orElse`
303 pprPanic "mk_whats_imported" (ppr n)
306 lt_occ n1 n2 = nameOccName n1 < nameOccName n2
308 maybe_export_vers | import_all_mod = Just (vers_exports version_info)
309 | otherwise = Nothing
314 %*********************************************************
316 \subsection{Slurping declarations}
318 %*********************************************************
321 -------------------------------------------------------
322 slurpImpDecls source_fvs
323 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
325 -- The current slurped-set records all local things
326 getSlurped `thenRn` \ source_binders ->
327 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
329 -- Then get everything else
330 closeDecls decls needed `thenRn` \ decls1 ->
332 -- Finally, get any deferred data type decls
333 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
338 -------------------------------------------------------
339 slurpSourceRefs :: NameSet -- Variables defined in source
340 -> FreeVars -- Variables referenced in source
341 -> RnMG ([RenamedHsDecl],
342 FreeVars) -- Un-satisfied needs
343 -- The declaration (and hence home module) of each gate has
344 -- already been loaded
346 slurpSourceRefs source_binders source_fvs
347 = go_outer [] -- Accumulating decls
348 emptyFVs -- Unsatisfied needs
349 emptyFVs -- Accumulating gates
350 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
352 -- The outer loop repeatedly slurps the decls for the current gates
353 -- and the instance decls
355 -- The outer loop is needed because consider
356 -- instance Foo a => Baz (Maybe a) where ...
357 -- It may be that @Baz@ and @Maybe@ are used in the source module,
358 -- but not @Foo@; so we need to chase @Foo@ too.
360 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
361 -- include actually getting in Foo's class decl
362 -- class Wib a => Foo a where ..
363 -- so that its superclasses are discovered. The point is that Wib is a gate too.
364 -- We do this for tycons too, so that we look through type synonyms.
366 go_outer decls fvs all_gates []
367 = returnRn (decls, fvs)
369 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
370 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
371 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
372 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
373 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
374 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
375 (nameSetToList (gates2 `minusNameSet` all_gates))
376 -- Knock out the all_gates because even if we don't slurp any new
377 -- decls we can get some apparently-new gates from wired-in names
379 go_inner (decls, fvs, gates) wanted_name
380 = importDecl wanted_name `thenRn` \ import_result ->
381 case import_result of
382 AlreadySlurped -> returnRn (decls, fvs, gates)
383 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
384 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
386 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
387 returnRn (TyClD new_decl : decls,
389 gates `plusFV` getGates source_fvs new_decl)
391 rnInstDecls decls fvs gates []
392 = returnRn (decls, fvs, gates)
393 rnInstDecls decls fvs gates (d:ds)
394 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
395 rnInstDecls (new_decl:decls)
397 (gates `plusFV` getInstDeclGates new_decl)
403 -------------------------------------------------------
404 -- closeDecls keeps going until the free-var set is empty
405 closeDecls decls needed
406 | not (isEmptyFVs needed)
407 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
408 closeDecls decls1 needed1
411 = getImportedRules `thenRn` \ rule_decls ->
413 [] -> returnRn decls -- No new rules, so we are done
414 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
415 closeDecls decls1 needed1
418 -------------------------------------------------------
419 -- Augment decls with any decls needed by needed.
420 -- Return also free vars of the new decls (only)
421 slurpDecls decls needed
422 = go decls emptyFVs (nameSetToList needed)
424 go decls fvs [] = returnRn (decls, fvs)
425 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
428 -------------------------------------------------------
429 slurpDecl decls fvs wanted_name
430 = importDecl wanted_name `thenRn` \ import_result ->
431 case import_result of
432 -- Found a declaration... rename it
433 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
434 returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
436 -- No declaration... (wired in thing, or deferred, or already slurped)
437 other -> returnRn (decls, fvs)
440 -------------------------------------------------------
441 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
442 -> [(Module, RdrNameHsDecl)]
443 -> RnM d ([RenamedHsDecl], FreeVars)
444 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
445 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
446 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
448 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
449 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl) `thenRn` \ decl' ->
450 returnRn (decl', tyClDeclFVs decl')
456 = getIfacesRn `thenRn` \ ifaces ->
457 returnRn (iSlurp ifaces)
459 recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = (imp_mods, imp_names) })
462 new_slurped_names = addAvailToNameSet slurped_names avail
463 new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names name)
464 | otherwise = (extendModuleSet imp_mods mod, imp_names)
466 mod = nameModule name
467 name = availName avail
469 ifaces { iSlurp = new_slurped_names, iVSlurp = new_vslurp }
471 recordLocalSlurps local_avails
472 = getIfacesRn `thenRn` \ ifaces ->
474 new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
476 setIfacesRn (ifaces { iSlurp = new_slurped_names })
481 %*********************************************************
483 \subsection{Deferred declarations}
485 %*********************************************************
487 The idea of deferred declarations is this. Suppose we have a function
492 Then we don't want to load T and all its constructors, and all
493 the types those constructors refer to, and all the types *those*
494 constructors refer to, and so on. That might mean loading many more
495 interface files than is really necessary. So we 'defer' loading T.
497 But f might be strict, and the calling convention for evaluating
498 values of type T depends on how many constructors T has, so
499 we do need to load T, but not the full details of the type T.
500 So we load the full decl for T, but only skeleton decls for A and B:
502 data T = {- 2 constructors -}
504 Whether all this is worth it is moot.
507 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
508 slurpDeferredDecls decls = returnRn decls
511 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
512 slurpDeferredDecls decls
513 = getDeferredDecls `thenRn` \ def_decls ->
514 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
515 ASSERT( isEmptyFVs fvs )
518 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ loc name1 name2))
519 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing loc
521 -- Nuke the context and constructors
522 -- But retain the *number* of constructors!
523 -- Also the tvs will have kinds on them.
528 %*********************************************************
530 \subsection{Extracting the `gates'}
532 %*********************************************************
534 When we import a declaration like
536 data T = T1 Wibble | T2 Wobble
538 we don't want to treat @Wibble@ and @Wobble@ as gates
539 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
540 If only @T@ is mentioned
541 we want only @T@ to be a gate;
542 that way we don't suck in useless instance
543 decls for (say) @Eq Wibble@, when they can't possibly be useful.
545 @getGates@ takes a newly imported (and renamed) decl, and the free
546 vars of the source program, and extracts from the decl the gate names.
549 getGates source_fvs (IfaceSig _ ty _ _)
550 = extractHsTyNames ty
552 getGates source_fvs (ClassDecl ctxt cls tvs _ sigs _ _ _ )
553 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
555 `addOneToNameSet` cls)
556 `plusFV` maybe_double
558 get (ClassOpSig n _ ty _)
559 | n `elemNameSet` source_fvs = extractHsTyNames ty
560 | otherwise = emptyFVs
562 -- If we load any numeric class that doesn't have
563 -- Int as an instance, add Double to the gates.
564 -- This takes account of the fact that Double might be needed for
565 -- defaulting, but we don't want to load Double (and all its baggage)
566 -- if the more exotic classes aren't used at all.
567 maybe_double | nameUnique cls `elem` fractionalClassKeys
568 = unitFV (getName doubleTyCon)
572 getGates source_fvs (TySynonym tycon tvs ty _)
573 = delListFromNameSet (extractHsTyNames ty)
575 -- A type synonym type constructor isn't a "gate" for instance decls
577 getGates source_fvs (TyData _ ctxt tycon tvs cons _ _ _ _ _)
578 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
580 `addOneToNameSet` tycon
582 get (ConDecl n _ tvs ctxt details _)
583 | n `elemNameSet` source_fvs
584 -- If the constructor is method, get fvs from all its fields
585 = delListFromNameSet (get_details details `plusFV`
586 extractHsCtxtTyNames ctxt)
588 get (ConDecl n _ tvs ctxt (RecCon fields) _)
589 -- Even if the constructor isn't mentioned, the fields
590 -- might be, as selectors. They can't mention existentially
591 -- bound tyvars (typechecker checks for that) so no need for
592 -- the deleteListFromNameSet part
593 = foldr (plusFV . get_field) emptyFVs fields
595 get other_con = emptyFVs
597 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
598 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
599 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
601 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
602 | otherwise = emptyFVs
604 get_bang bty = extractHsTyNames (getBangType bty)
607 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
608 rather than a declaration.
611 getWiredInGates :: Name -> FreeVars
612 getWiredInGates name -- No classes are wired in
613 = case lookupNameEnv wiredInThingEnv name of
614 Just (AnId the_id) -> getWiredInGates_s (namesOfType (idType the_id))
618 -> getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
620 (tyvars,ty) = getSynTyConDefn tc
624 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
628 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
629 getInstDeclGates other = emptyFVs
633 %*********************************************************
635 \subsection{Getting in a declaration}
637 %*********************************************************
640 importDecl :: Name -> RnMG ImportDeclResult
642 data ImportDeclResult
646 | HereItIs (Module, RdrNameTyClDecl)
649 = -- Check if it was loaded before beginning this module
650 if isLocallyDefined name then
651 returnRn AlreadySlurped
653 checkAlreadyAvailable name `thenRn` \ done ->
655 returnRn AlreadySlurped
658 -- Check if we slurped it in while compiling this module
659 getIfacesRn `thenRn` \ ifaces ->
660 if name `elemNameSet` iSlurp ifaces then
661 returnRn AlreadySlurped
664 -- Don't slurp in decls from this module's own interface file
665 -- (Indeed, this shouldn't happen.)
666 if isLocallyDefined name then
667 addWarnRn (importDeclWarn name) `thenRn_`
668 returnRn AlreadySlurped
671 -- When we find a wired-in name we must load its home
672 -- module so that we find any instance decls lurking therein
673 if name `elemNameEnv` wiredInThingEnv then
674 loadHomeInterface doc name `thenRn_`
677 else getNonWiredInDecl name
679 doc = ptext SLIT("need home module for wired in thing") <+> ppr name
681 getNonWiredInDecl :: Name -> RnMG ImportDeclResult
682 getNonWiredInDecl needed_name
683 = traceRn doc_str `thenRn_`
684 loadHomeInterface doc_str needed_name `thenRn_`
685 getIfacesRn `thenRn` \ ifaces ->
686 case lookupNameEnv (iDecls ifaces) needed_name of
688 {- OMIT DEFERRED STUFF FOR NOW, TILL GHCI WORKS
689 Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _ _)))
690 -- This case deals with deferred import of algebraic data types
692 | not opt_NoPruneTyDecls
694 && (opt_IgnoreIfacePragmas || ncons > 1)
695 -- We only defer if imported interface pragmas are ingored
696 -- or if it's not a product type.
697 -- Sole reason: The wrapper for a strict function may need to look
698 -- inside its arg, and hence need to see its arg type's constructors.
700 && not (getUnique tycon_name `elem` cCallishTyKeys)
701 -- Never defer ccall types; we have to unbox them,
702 -- and importing them does no harm
705 -> -- OK, so we're importing a deferrable data type
706 if needed_name == tycon_name
707 -- The needed_name is the TyCon of a data type decl
708 -- Record that it's slurped, put it in the deferred set
709 -- and don't return a declaration at all
710 setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces
711 `addOneToNameSet` tycon_name})
712 version (AvailTC needed_name [needed_name])) `thenRn_`
716 -- The needed name is a constructor of a data type decl,
717 -- getting a constructor, so remove the TyCon from the deferred set
718 -- (if it's there) and return the full declaration
719 setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces
720 `delFromNameSet` tycon_name})
721 version avail) `thenRn_`
722 returnRn (HereItIs decl)
724 tycon_name = availName avail
728 -> setIfacesRn (recordSlurp ifaces avail) `thenRn_`
729 returnRn (HereItIs decl)
732 -> addErrRn (getDeclErr needed_name) `thenRn_`
733 returnRn AlreadySlurped
735 doc_str = ptext SLIT("need decl for") <+> ppr needed_name
738 getDeferredDecls :: RnMG [(Module, RdrNameHsDecl)]
740 = getIfacesRn `thenRn` \ ifaces ->
742 decls_map = iDecls ifaces
743 deferred_names = nameSetToList (iDeferred ifaces)
744 get_abstract_decl n = case lookupNameEnv decls_map n of
745 Just (_, _, _, decl) -> decl
747 traceRn (sep [text "getDeferredDecls", nest 4 (fsep (map ppr deferred_names))]) `thenRn_`
748 returnRn (map get_abstract_decl deferred_names)
752 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
753 It behaves exactly as if the wired in decl were actually in an interface file.
756 \item if the wired-in name is a data type constructor or a data constructor,
757 it brings in the type constructor and all the data constructors; and
758 marks as ``occurrences'' any free vars of the data con.
760 \item similarly for synonum type constructor
762 \item if the wired-in name is another wired-in Id, it marks as ``occurrences''
763 the free vars of the Id's type.
765 \item it loads the interface file for the wired-in thing for the
766 sole purpose of making sure that its instance declarations are available
768 All this is necessary so that we know all types that are ``in play'', so
769 that we know just what instances to bring into scope.
772 %********************************************************
774 \subsection{Checking usage information}
776 %********************************************************
778 @recompileRequired@ is called from the HscMain. It checks whether
779 a recompilation is required. It needs access to the persistent state,
780 finder, etc, because it may have to load lots of interface files to
781 check their versions.
784 type RecompileRequired = Bool
785 upToDate = False -- Recompile not required
786 outOfDate = True -- Recompile required
788 recompileRequired :: FilePath -- Only needed for debug msgs
789 -> Bool -- Source unchanged
790 -> Maybe ModIface -- Old interface, if any
791 -> RnMG RecompileRequired
792 recompileRequired iface_path source_unchanged maybe_iface
793 = traceRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
795 -- CHECK WHETHER THE SOURCE HAS CHANGED
796 if not source_unchanged then
797 traceRn (nest 4 (text "Source file changed or recompilation check turned off")) `thenRn_`
801 -- CHECK WHETHER WE HAVE AN OLD IFACE
803 Nothing -> traceRn (nest 4 (ptext SLIT("No old interface file"))) `thenRn_`
806 Just iface -> -- Source code unchanged and no errors yet... carry on
807 checkList [checkModUsage u | u <- mi_usages iface]
809 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
810 checkList [] = returnRn upToDate
811 checkList (check:checks) = check `thenRn` \ recompile ->
819 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
820 -- Given the usage information extracted from the old
821 -- M.hi file for the module being compiled, figure out
822 -- whether M needs to be recompiled.
824 checkModUsage (mod_name, _, _, NothingAtAll)
825 -- If CurrentModule.hi contains
827 -- then that simply records that Foo lies below CurrentModule in the
828 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
829 -- In this case we don't even want to open Foo's interface.
830 = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
832 checkModUsage (mod_name, _, _, whats_imported)
833 = tryLoadInterface doc_str mod_name ImportBySystem `thenRn` \ (iface, maybe_err) ->
835 Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
837 -- Couldn't find or parse a module mentioned in the
838 -- old interface file. Don't complain -- it might just be that
839 -- the current module doesn't need that import and it's been deleted
843 new_vers = mi_version iface
844 new_decl_vers = vers_decls new_vers
846 case whats_imported of { -- NothingAtAll dealt with earlier
848 Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
850 out_of_date (ptext SLIT("...and I needed the whole module"))
854 Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
857 checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
858 if not recompile then
863 if checkExportList maybe_old_export_vers new_vers then
864 out_of_date (ptext SLIT("Export list changed"))
868 if old_rule_vers /= vers_rules new_vers then
869 out_of_date (ptext SLIT("Rules changed"))
872 -- CHECK ITEMS ONE BY ONE
873 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenRn` \ recompile ->
875 returnRn outOfDate -- This one failed, so just bail out now
877 up_to_date (ptext SLIT("...but the bits I use haven't."))
881 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
883 ------------------------
884 checkModuleVersion old_mod_vers new_vers
885 | vers_module new_vers == old_mod_vers
886 = up_to_date (ptext SLIT("Module version unchanged"))
889 = out_of_date (ptext SLIT("Module version has changed"))
891 ------------------------
892 checkExportList Nothing new_vers = upToDate
893 checkExportList (Just v) new_vers = v /= vers_exports new_vers
895 ------------------------
896 checkEntityUsage new_vers (name,old_vers)
897 = case lookupNameEnv new_vers name of
899 Nothing -> -- We used it before, but it ain't there now
900 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
902 Just new_vers -- It's there, but is it up to date?
903 | new_vers == old_vers -> returnRn upToDate
904 | otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
906 up_to_date msg = traceRn msg `thenRn_` returnRn upToDate
907 out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate
911 %*********************************************************
915 %*********************************************************
919 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
920 ptext SLIT("from module") <+> quotes (ppr (nameModule name))
925 "Compiler tried to import decl from interface file with same name as module."),
927 "(possible cause: module name clashes with interface file already in scope.)")
929 hsep [ptext SLIT("name:"), quotes (ppr name)]