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, isLocalName, nameUnique,
42 import Name ( elemNameEnv )
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) })
461 = ASSERT2( not (isLocalName (availName avail)), pprAvail avail )
462 ifaces { iSlurp = new_slurped_names, iVSlurp = new_vslurp }
464 main_name = availName avail
465 mod = nameModule main_name
466 new_slurped_names = addAvailToNameSet slurped_names avail
467 new_vslurp | isModuleInThisPackage mod = (imp_mods, addOneToNameSet imp_names main_name)
468 | otherwise = (extendModuleSet imp_mods mod, imp_names)
470 recordLocalSlurps local_avails
471 = getIfacesRn `thenRn` \ ifaces ->
473 new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
475 setIfacesRn (ifaces { iSlurp = new_slurped_names })
480 %*********************************************************
482 \subsection{Deferred declarations}
484 %*********************************************************
486 The idea of deferred declarations is this. Suppose we have a function
491 Then we don't want to load T and all its constructors, and all
492 the types those constructors refer to, and all the types *those*
493 constructors refer to, and so on. That might mean loading many more
494 interface files than is really necessary. So we 'defer' loading T.
496 But f might be strict, and the calling convention for evaluating
497 values of type T depends on how many constructors T has, so
498 we do need to load T, but not the full details of the type T.
499 So we load the full decl for T, but only skeleton decls for A and B:
501 data T = {- 2 constructors -}
503 Whether all this is worth it is moot.
506 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
507 slurpDeferredDecls decls = returnRn decls
510 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
511 slurpDeferredDecls decls
512 = getDeferredDecls `thenRn` \ def_decls ->
513 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
514 ASSERT( isEmptyFVs fvs )
517 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ loc name1 name2))
518 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing loc
520 -- Nuke the context and constructors
521 -- But retain the *number* of constructors!
522 -- Also the tvs will have kinds on them.
527 %*********************************************************
529 \subsection{Extracting the `gates'}
531 %*********************************************************
533 When we import a declaration like
535 data T = T1 Wibble | T2 Wobble
537 we don't want to treat @Wibble@ and @Wobble@ as gates
538 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
539 If only @T@ is mentioned
540 we want only @T@ to be a gate;
541 that way we don't suck in useless instance
542 decls for (say) @Eq Wibble@, when they can't possibly be useful.
544 @getGates@ takes a newly imported (and renamed) decl, and the free
545 vars of the source program, and extracts from the decl the gate names.
548 getGates source_fvs (IfaceSig _ ty _ _)
549 = extractHsTyNames ty
551 getGates source_fvs (ClassDecl ctxt cls tvs _ sigs _ _ _ )
552 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
554 `addOneToNameSet` cls)
555 `plusFV` maybe_double
557 get (ClassOpSig n _ ty _)
558 | n `elemNameSet` source_fvs = extractHsTyNames ty
559 | otherwise = emptyFVs
561 -- If we load any numeric class that doesn't have
562 -- Int as an instance, add Double to the gates.
563 -- This takes account of the fact that Double might be needed for
564 -- defaulting, but we don't want to load Double (and all its baggage)
565 -- if the more exotic classes aren't used at all.
566 maybe_double | nameUnique cls `elem` fractionalClassKeys
567 = unitFV (getName doubleTyCon)
571 getGates source_fvs (TySynonym tycon tvs ty _)
572 = delListFromNameSet (extractHsTyNames ty)
574 -- A type synonym type constructor isn't a "gate" for instance decls
576 getGates source_fvs (TyData _ ctxt tycon tvs cons _ _ _ _ _)
577 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
579 `addOneToNameSet` tycon
581 get (ConDecl n _ tvs ctxt details _)
582 | n `elemNameSet` source_fvs
583 -- If the constructor is method, get fvs from all its fields
584 = delListFromNameSet (get_details details `plusFV`
585 extractHsCtxtTyNames ctxt)
587 get (ConDecl n _ tvs ctxt (RecCon fields) _)
588 -- Even if the constructor isn't mentioned, the fields
589 -- might be, as selectors. They can't mention existentially
590 -- bound tyvars (typechecker checks for that) so no need for
591 -- the deleteListFromNameSet part
592 = foldr (plusFV . get_field) emptyFVs fields
594 get other_con = emptyFVs
596 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
597 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
598 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
600 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
601 | otherwise = emptyFVs
603 get_bang bty = extractHsTyNames (getBangType bty)
606 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
607 rather than a declaration.
610 getWiredInGates :: Name -> FreeVars
611 getWiredInGates name -- No classes are wired in
612 = case lookupNameEnv wiredInThingEnv name of
613 Just (AnId the_id) -> getWiredInGates_s (namesOfType (idType the_id))
617 -> getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
619 (tyvars,ty) = getSynTyConDefn tc
623 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
627 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
628 getInstDeclGates other = emptyFVs
632 %*********************************************************
634 \subsection{Getting in a declaration}
636 %*********************************************************
639 importDecl :: Name -> RnMG ImportDeclResult
641 data ImportDeclResult
645 | HereItIs (Module, RdrNameTyClDecl)
648 = -- Check if it was loaded before beginning this module
649 if isLocalName name then
650 returnRn AlreadySlurped
652 checkAlreadyAvailable name `thenRn` \ done ->
654 returnRn AlreadySlurped
657 -- Check if we slurped it in while compiling this module
658 getIfacesRn `thenRn` \ ifaces ->
659 if name `elemNameSet` iSlurp ifaces then
660 returnRn AlreadySlurped
663 -- When we find a wired-in name we must load its home
664 -- module so that we find any instance decls lurking therein
665 if name `elemNameEnv` wiredInThingEnv then
666 loadHomeInterface doc name `thenRn_`
669 else getNonWiredInDecl name
671 doc = ptext SLIT("need home module for wired in thing") <+> ppr name
673 getNonWiredInDecl :: Name -> RnMG ImportDeclResult
674 getNonWiredInDecl needed_name
675 = traceRn doc_str `thenRn_`
676 loadHomeInterface doc_str needed_name `thenRn_`
677 getIfacesRn `thenRn` \ ifaces ->
678 case lookupNameEnv (iDecls ifaces) needed_name of
680 {- OMIT DEFERRED STUFF FOR NOW, TILL GHCI WORKS
681 Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _ _)))
682 -- This case deals with deferred import of algebraic data types
684 | not opt_NoPruneTyDecls
686 && (opt_IgnoreIfacePragmas || ncons > 1)
687 -- We only defer if imported interface pragmas are ingored
688 -- or if it's not a product type.
689 -- Sole reason: The wrapper for a strict function may need to look
690 -- inside its arg, and hence need to see its arg type's constructors.
692 && not (getUnique tycon_name `elem` cCallishTyKeys)
693 -- Never defer ccall types; we have to unbox them,
694 -- and importing them does no harm
697 -> -- OK, so we're importing a deferrable data type
698 if needed_name == tycon_name
699 -- The needed_name is the TyCon of a data type decl
700 -- Record that it's slurped, put it in the deferred set
701 -- and don't return a declaration at all
702 setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces
703 `addOneToNameSet` tycon_name})
704 version (AvailTC needed_name [needed_name])) `thenRn_`
708 -- The needed name is a constructor of a data type decl,
709 -- getting a constructor, so remove the TyCon from the deferred set
710 -- (if it's there) and return the full declaration
711 setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces
712 `delFromNameSet` tycon_name})
713 version avail) `thenRn_`
714 returnRn (HereItIs decl)
716 tycon_name = availName avail
720 -> setIfacesRn (recordSlurp ifaces avail) `thenRn_`
721 returnRn (HereItIs decl)
724 -> addErrRn (getDeclErr needed_name) `thenRn_`
725 returnRn AlreadySlurped
727 doc_str = ptext SLIT("need decl for") <+> ppr needed_name
730 getDeferredDecls :: RnMG [(Module, RdrNameHsDecl)]
732 = getIfacesRn `thenRn` \ ifaces ->
734 decls_map = iDecls ifaces
735 deferred_names = nameSetToList (iDeferred ifaces)
736 get_abstract_decl n = case lookupNameEnv decls_map n of
737 Just (_, _, _, decl) -> decl
739 traceRn (sep [text "getDeferredDecls", nest 4 (fsep (map ppr deferred_names))]) `thenRn_`
740 returnRn (map get_abstract_decl deferred_names)
744 @getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
745 It behaves exactly as if the wired in decl were actually in an interface file.
748 \item if the wired-in name is a data type constructor or a data constructor,
749 it brings in the type constructor and all the data constructors; and
750 marks as ``occurrences'' any free vars of the data con.
752 \item similarly for synonum type constructor
754 \item if the wired-in name is another wired-in Id, it marks as ``occurrences''
755 the free vars of the Id's type.
757 \item it loads the interface file for the wired-in thing for the
758 sole purpose of making sure that its instance declarations are available
760 All this is necessary so that we know all types that are ``in play'', so
761 that we know just what instances to bring into scope.
764 %********************************************************
766 \subsection{Checking usage information}
768 %********************************************************
770 @recompileRequired@ is called from the HscMain. It checks whether
771 a recompilation is required. It needs access to the persistent state,
772 finder, etc, because it may have to load lots of interface files to
773 check their versions.
776 type RecompileRequired = Bool
777 upToDate = False -- Recompile not required
778 outOfDate = True -- Recompile required
780 recompileRequired :: FilePath -- Only needed for debug msgs
781 -> Bool -- Source unchanged
782 -> ModIface -- Old interface
783 -> RnMG RecompileRequired
784 recompileRequired iface_path source_unchanged iface
785 = traceRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
787 -- CHECK WHETHER THE SOURCE HAS CHANGED
788 if not source_unchanged then
789 traceRn (nest 4 (text "Source file changed or recompilation check turned off")) `thenRn_`
793 -- Source code unchanged and no errors yet... carry on
794 checkList [checkModUsage u | u <- mi_usages iface]
796 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
797 checkList [] = returnRn upToDate
798 checkList (check:checks) = check `thenRn` \ recompile ->
806 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
807 -- Given the usage information extracted from the old
808 -- M.hi file for the module being compiled, figure out
809 -- whether M needs to be recompiled.
811 checkModUsage (mod_name, _, _, NothingAtAll)
812 -- If CurrentModule.hi contains
814 -- then that simply records that Foo lies below CurrentModule in the
815 -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
816 -- In this case we don't even want to open Foo's interface.
817 = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
819 checkModUsage (mod_name, _, _, whats_imported)
820 = tryLoadInterface doc_str mod_name ImportBySystem `thenRn` \ (iface, maybe_err) ->
822 Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"),
824 -- Couldn't find or parse a module mentioned in the
825 -- old interface file. Don't complain -- it might just be that
826 -- the current module doesn't need that import and it's been deleted
830 new_vers = mi_version iface
831 new_decl_vers = vers_decls new_vers
833 case whats_imported of { -- NothingAtAll dealt with earlier
835 Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
837 out_of_date (ptext SLIT("...and I needed the whole module"))
841 Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
844 checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
845 if not recompile then
850 if checkExportList maybe_old_export_vers new_vers then
851 out_of_date (ptext SLIT("Export list changed"))
855 if old_rule_vers /= vers_rules new_vers then
856 out_of_date (ptext SLIT("Rules changed"))
859 -- CHECK ITEMS ONE BY ONE
860 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenRn` \ recompile ->
862 returnRn outOfDate -- This one failed, so just bail out now
864 up_to_date (ptext SLIT("...but the bits I use haven't."))
868 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
870 ------------------------
871 checkModuleVersion old_mod_vers new_vers
872 | vers_module new_vers == old_mod_vers
873 = up_to_date (ptext SLIT("Module version unchanged"))
876 = out_of_date (ptext SLIT("Module version has changed"))
878 ------------------------
879 checkExportList Nothing new_vers = upToDate
880 checkExportList (Just v) new_vers = v /= vers_exports new_vers
882 ------------------------
883 checkEntityUsage new_vers (name,old_vers)
884 = case lookupNameEnv new_vers name of
886 Nothing -> -- We used it before, but it ain't there now
887 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
889 Just new_vers -- It's there, but is it up to date?
890 | new_vers == old_vers -> returnRn upToDate
891 | otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
893 up_to_date msg = traceRn msg `thenRn_` returnRn upToDate
894 out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate
898 %*********************************************************
902 %*********************************************************
906 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
907 ptext SLIT("from module") <+> quotes (ppr (nameModule name))