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 ( DynFlags, opt_NoPruneDecls, opt_NoPruneTyDecls, opt_IgnoreIfacePragmas )
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, mkVanillaModule,
44 moduleName, isModuleInThisPackage,
45 ModuleName, WhereFrom(..),
46 emptyModuleEnv, lookupModuleEnvByName,
47 extendModuleEnv_C, lookupWithDefaultModuleEnv
50 import PrelInfo ( wiredInThingEnv, fractionalClassKeys )
51 import TysWiredIn ( doubleTyCon )
52 import Maybes ( orElse )
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 = getHomeIfaceTableRn `thenRn` \ hit ->
73 case lookupModuleEnvByName hit mod_name of {
74 Just mi -> returnRn (mi_module mi, mi_exports mi) ;
77 loadInterface doc_str mod_name from `thenRn` \ ifaces ->
78 case lookupModuleEnvByName (iPIT ifaces) mod_name of
79 Just mi -> returnRn (mi_module mi, mi_exports mi) ;
80 -- loadInterface always puts something in the map
81 -- even if it's a fake
82 Nothing -> returnRn (mkVanillaModule mod_name, [])
83 -- pprPanic "getInterfaceExports" (ppr mod_name)
86 doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")]
90 %*********************************************************
92 \subsection{Instance declarations are handled specially}
94 %*********************************************************
97 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
98 getImportedInstDecls gates
99 = -- First, load any orphan-instance modules that aren't aready loaded
100 -- Orphan-instance modules are recorded in the module dependecnies
101 getIfacesRn `thenRn` \ ifaces ->
104 [mod | (mod, (True, _, False)) <- fmToList (iImpModInfo ifaces)]
106 loadOrphanModules orphan_mods `thenRn_`
108 -- Now we're ready to grab the instance declarations
109 -- Find the un-gated ones and return them,
110 -- removing them from the bag kept in Ifaces
111 getIfacesRn `thenRn` \ ifaces ->
113 (decls, new_insts) = selectGated gates (iInsts ifaces)
115 setIfacesRn (ifaces { iInsts = new_insts }) `thenRn_`
117 traceRn (sep [text "getImportedInstDecls:",
118 nest 4 (fsep (map ppr gate_list)),
119 text "Slurped" <+> int (length decls) <+> text "instance declarations",
120 nest 4 (vcat (map ppr_brief_inst_decl decls))]) `thenRn_`
123 gate_list = nameSetToList gates
125 ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
127 HsForAllTy _ _ tau -> ppr tau
130 getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
132 | opt_IgnoreIfacePragmas = returnRn []
134 = getIfacesRn `thenRn` \ ifaces ->
136 gates = iSlurp ifaces -- Anything at all that's been slurped
137 rules = iRules ifaces
138 (decls, new_rules) = selectGated gates rules
143 setIfacesRn (ifaces { iRules = new_rules }) `thenRn_`
144 traceRn (sep [text "getImportedRules:",
145 text "Slurped" <+> int (length decls) <+> text "rules"]) `thenRn_`
148 selectGated gates decl_bag
149 -- Select only those decls whose gates are *all* in 'gates'
151 | opt_NoPruneDecls -- Just to try the effect of not gating at all
152 = (foldrBag (\ (_,d) ds -> d:ds) [] decl_bag, emptyBag) -- Grab them all
156 = foldrBag select ([], emptyBag) decl_bag
158 select (reqd, decl) (yes, no)
159 | isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
160 | otherwise = (yes, (reqd,decl) `consBag` no)
164 %*********************************************************
166 \subsection{Keeping track of what we've slurped, and version numbers}
168 %*********************************************************
170 getImportVersions figures out what the ``usage information'' for this
171 moudule is; that is, what it must record in its interface file as the
172 things it uses. It records:
175 \item (a) anything reachable from its body code
176 \item (b) any module exported with a @module Foo@
177 \item (c) anything reachable from an exported item
180 Why (b)? Because if @Foo@ changes then this module's export list
181 will change, so we must recompile this module at least as far as
182 making a new interface file --- but in practice that means complete
185 Why (c)? Consider this:
187 module A( f, g ) where | module B( f ) where
188 import B( f ) | f = h 3
192 Here, @B.f@ isn't used in A. Should we nevertheless record @B.f@ in
193 @A@'s usages? Our idea is that we aren't going to touch A.hi if it is
194 *identical* to what it was before. If anything about @B.f@ changes
195 than anyone who imports @A@ should be recompiled in case they use
196 @B.f@ (they'll get an early exit if they don't). So, if anything
197 about @B.f@ changes we'd better make sure that something in A.hi
198 changes, and the convenient way to do that is to record the version
199 number @B.f@ in A.hi in the usage list. If B.f changes that'll force a
200 complete recompiation of A, which is overkill but it's the only way to
201 write a new, slightly different, A.hi.
203 But the example is tricker. Even if @B.f@ doesn't change at all,
204 @B.h@ may do so, and this change may not be reflected in @f@'s version
205 number. But with -O, a module that imports A must be recompiled if
206 @B.h@ changes! So A must record a dependency on @B.h@. So we treat
207 the occurrence of @B.f@ in the export list *just as if* it were in the
208 code of A, and thereby haul in all the stuff reachable from it.
210 [NB: If B was compiled with -O, but A isn't, we should really *still*
211 haul in all the unfoldings for B, in case the module that imports A *is*
212 compiled with -O. I think this is the case.]
214 Even if B is used at all we get a usage line for B
215 import B <n> :: ... ;
216 in A.hi, to record the fact that A does import B. This is used to decide
217 to look to look for B.hi rather than B.hi-boot when compiling a module that
218 imports A. This line says that A imports B, but uses nothing in it.
219 So we'll get an early bale-out when compiling A if B's version changes.
222 mkImportInfo :: ModuleName -- Name of this module
223 -> [ImportDecl n] -- The import decls
224 -> RnMG [ImportVersion Name]
226 mkImportInfo this_mod imports
227 = getIfacesRn `thenRn` \ ifaces ->
228 getHomeIfaceTableRn `thenRn` \ hit ->
230 import_all_mods :: [ModuleName]
231 -- Modules where we imported all the names
232 -- (apart from hiding some, perhaps)
233 import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports,
234 import_all imp_list ]
236 import_all (Just (False, _)) = False -- Imports are specified explicitly
237 import_all other = True -- Everything is imported
239 mod_map = iImpModInfo ifaces
240 imp_names = iVSlurp ifaces
243 -- mv_map groups together all the things imported from a particular module.
244 mv_map :: ModuleEnv [Name]
245 mv_map = foldr add_mv emptyModuleEnv imp_names
247 add_mv name mv_map = addItem mv_map (nameModule name) name
249 -- Build the result list by adding info for each module.
250 -- For (a) a library module, we don't record it at all unless it contains orphans
251 -- (We must never lose track of orphans.)
253 -- (b) a home-package module
255 mk_imp_info mod_name (has_orphans, is_boot, opened) so_far
256 | mod_name == this_mod -- Check if M appears in the set of modules 'below' M
257 -- This seems like a convenient place to check
258 = WARN( not is_boot, ptext SLIT("Wierd:") <+> ppr this_mod <+>
259 ptext SLIT("imports itself (perhaps indirectly)") )
262 | not opened -- We didn't even open the interface
263 = -- This happens when a module, Foo, that we explicitly imported has
264 -- 'import Baz' in its interface file, recording that Baz is below
265 -- Foo in the module dependency hierarchy. We want to propagate this
266 -- information. The Nothing says that we didn't even open the interface
267 -- file but we must still propagate the dependency info.
268 -- The module in question must be a local module (in the same package)
269 go_for_it NothingAtAll
273 -- Ignore modules from other packages, unless it has
274 -- orphans, in which case we must remember it in our
275 -- dependencies. But in that case we only record the
276 -- module version, nothing more detailed
277 = if has_orphans then
278 go_for_it (Everything module_vers)
283 = go_for_it whats_imported
286 go_for_it exports = (mod_name, has_orphans, is_boot, exports) : so_far
287 mod_iface = lookupTableByModName hit pit mod_name `orElse` panic "mkImportInfo"
288 mod = mi_module mod_iface
289 is_lib_module = not (isModuleInThisPackage mod)
290 version_info = mi_version mod_iface
291 version_env = vers_decls version_info
292 module_vers = vers_module version_info
294 whats_imported = Specifically module_vers
295 export_vers import_items
296 (vers_rules version_info)
298 import_items = [(n,v) | n <- lookupWithDefaultModuleEnv mv_map [] mod,
299 let v = lookupNameEnv version_env n `orElse`
300 pprPanic "mk_whats_imported" (ppr n)
302 export_vers | moduleName mod `elem` import_all_mods
303 = Just (vers_exports version_info)
307 import_info = foldFM mk_imp_info [] mod_map
309 traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map))) `thenRn_`
313 addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a]
314 addItem fm mod x = extendModuleEnv_C add_item fm mod [x]
319 %*********************************************************
321 \subsection{Slurping declarations}
323 %*********************************************************
326 -------------------------------------------------------
327 slurpImpDecls source_fvs
328 = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
330 -- The current slurped-set records all local things
331 getSlurped `thenRn` \ source_binders ->
332 slurpSourceRefs source_binders source_fvs `thenRn` \ (decls, needed) ->
334 -- Then get everything else
335 closeDecls decls needed `thenRn` \ decls1 ->
337 -- Finally, get any deferred data type decls
338 slurpDeferredDecls decls1 `thenRn` \ final_decls ->
343 -------------------------------------------------------
344 slurpSourceRefs :: NameSet -- Variables defined in source
345 -> FreeVars -- Variables referenced in source
346 -> RnMG ([RenamedHsDecl],
347 FreeVars) -- Un-satisfied needs
348 -- The declaration (and hence home module) of each gate has
349 -- already been loaded
351 slurpSourceRefs source_binders source_fvs
352 = go_outer [] -- Accumulating decls
353 emptyFVs -- Unsatisfied needs
354 emptyFVs -- Accumulating gates
355 (nameSetToList source_fvs) -- Things whose defn hasn't been loaded yet
357 -- The outer loop repeatedly slurps the decls for the current gates
358 -- and the instance decls
360 -- The outer loop is needed because consider
361 -- instance Foo a => Baz (Maybe a) where ...
362 -- It may be that @Baz@ and @Maybe@ are used in the source module,
363 -- but not @Foo@; so we need to chase @Foo@ too.
365 -- We also need to follow superclass refs. In particular, 'chasing @Foo@' must
366 -- include actually getting in Foo's class decl
367 -- class Wib a => Foo a where ..
368 -- so that its superclasses are discovered. The point is that Wib is a gate too.
369 -- We do this for tycons too, so that we look through type synonyms.
371 go_outer decls fvs all_gates []
372 = returnRn (decls, fvs)
374 go_outer decls fvs all_gates refs -- refs are not necessarily slurped yet
375 = traceRn (text "go_outer" <+> ppr refs) `thenRn_`
376 foldlRn go_inner (decls, fvs, emptyFVs) refs `thenRn` \ (decls1, fvs1, gates1) ->
377 getImportedInstDecls (all_gates `plusFV` gates1) `thenRn` \ inst_decls ->
378 rnInstDecls decls1 fvs1 gates1 inst_decls `thenRn` \ (decls2, fvs2, gates2) ->
379 go_outer decls2 fvs2 (all_gates `plusFV` gates2)
380 (nameSetToList (gates2 `minusNameSet` all_gates))
381 -- Knock out the all_gates because even if we don't slurp any new
382 -- decls we can get some apparently-new gates from wired-in names
384 go_inner (decls, fvs, gates) wanted_name
385 = importDecl wanted_name `thenRn` \ import_result ->
386 case import_result of
387 AlreadySlurped -> returnRn (decls, fvs, gates)
388 WiredIn -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
389 Deferred -> returnRn (decls, fvs, gates `addOneFV` wanted_name) -- It's a type constructor
391 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
392 returnRn (TyClD new_decl : decls,
394 gates `plusFV` getGates source_fvs new_decl)
396 rnInstDecls decls fvs gates []
397 = returnRn (decls, fvs, gates)
398 rnInstDecls decls fvs gates (d:ds)
399 = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
400 rnInstDecls (new_decl:decls)
402 (gates `plusFV` getInstDeclGates new_decl)
408 -------------------------------------------------------
409 -- closeDecls keeps going until the free-var set is empty
410 closeDecls decls needed
411 | not (isEmptyFVs needed)
412 = slurpDecls decls needed `thenRn` \ (decls1, needed1) ->
413 closeDecls decls1 needed1
416 = getImportedRules `thenRn` \ rule_decls ->
418 [] -> returnRn decls -- No new rules, so we are done
419 other -> rnIfaceDecls decls emptyFVs rule_decls `thenRn` \ (decls1, needed1) ->
420 closeDecls decls1 needed1
423 -------------------------------------------------------
424 -- Augment decls with any decls needed by needed.
425 -- Return also free vars of the new decls (only)
426 slurpDecls decls needed
427 = go decls emptyFVs (nameSetToList needed)
429 go decls fvs [] = returnRn (decls, fvs)
430 go decls fvs (ref:refs) = slurpDecl decls fvs ref `thenRn` \ (decls1, fvs1) ->
433 -------------------------------------------------------
434 slurpDecl decls fvs wanted_name
435 = importDecl wanted_name `thenRn` \ import_result ->
436 case import_result of
437 -- Found a declaration... rename it
438 HereItIs decl -> rnIfaceTyClDecl decl `thenRn` \ (new_decl, fvs1) ->
439 returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)
441 -- No declaration... (wired in thing, or deferred, or already slurped)
442 other -> returnRn (decls, fvs)
445 -------------------------------------------------------
446 rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
447 -> [(Module, RdrNameHsDecl)]
448 -> RnM d ([RenamedHsDecl], FreeVars)
449 rnIfaceDecls decls fvs [] = returnRn (decls, fvs)
450 rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d `thenRn` \ (new_decl, fvs1) ->
451 rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds
453 rnIfaceDecl (mod, decl) = initIfaceRnMS mod (rnDecl decl)
454 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl) `thenRn` \ decl' ->
455 returnRn (decl', tyClDeclFVs decl')
461 = getIfacesRn `thenRn` \ ifaces ->
462 returnRn (iSlurp ifaces)
464 recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = imp_names })
467 new_slurped_names = addAvailToNameSet slurped_names avail
468 new_imp_names = availName avail : imp_names
470 ifaces { iSlurp = new_slurped_names, iVSlurp = new_imp_names }
472 recordLocalSlurps local_avails
473 = getIfacesRn `thenRn` \ ifaces ->
475 new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
477 setIfacesRn (ifaces { iSlurp = new_slurped_names })
482 %*********************************************************
484 \subsection{Deferred declarations}
486 %*********************************************************
488 The idea of deferred declarations is this. Suppose we have a function
493 Then we don't want to load T and all its constructors, and all
494 the types those constructors refer to, and all the types *those*
495 constructors refer to, and so on. That might mean loading many more
496 interface files than is really necessary. So we 'defer' loading T.
498 But f might be strict, and the calling convention for evaluating
499 values of type T depends on how many constructors T has, so
500 we do need to load T, but not the full details of the type T.
501 So we load the full decl for T, but only skeleton decls for A and B:
503 data T = {- 2 constructors -}
505 Whether all this is worth it is moot.
508 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
509 slurpDeferredDecls decls = returnRn decls
512 slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
513 slurpDeferredDecls decls
514 = getDeferredDecls `thenRn` \ def_decls ->
515 rnIfaceDecls decls emptyFVs (map stripDecl def_decls) `thenRn` \ (decls1, fvs) ->
516 ASSERT( isEmptyFVs fvs )
519 stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ loc name1 name2))
520 = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing loc
522 -- Nuke the context and constructors
523 -- But retain the *number* of constructors!
524 -- Also the tvs will have kinds on them.
529 %*********************************************************
531 \subsection{Extracting the `gates'}
533 %*********************************************************
535 When we import a declaration like
537 data T = T1 Wibble | T2 Wobble
539 we don't want to treat @Wibble@ and @Wobble@ as gates
540 {\em unless} @T1@, @T2@ respectively are mentioned by the user program.
541 If only @T@ is mentioned
542 we want only @T@ to be a gate;
543 that way we don't suck in useless instance
544 decls for (say) @Eq Wibble@, when they can't possibly be useful.
546 @getGates@ takes a newly imported (and renamed) decl, and the free
547 vars of the source program, and extracts from the decl the gate names.
550 getGates source_fvs (IfaceSig _ ty _ _)
551 = extractHsTyNames ty
553 getGates source_fvs (ClassDecl ctxt cls tvs _ sigs _ _ _ )
554 = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
556 `addOneToNameSet` cls)
557 `plusFV` maybe_double
559 get (ClassOpSig n _ ty _)
560 | n `elemNameSet` source_fvs = extractHsTyNames ty
561 | otherwise = emptyFVs
563 -- If we load any numeric class that doesn't have
564 -- Int as an instance, add Double to the gates.
565 -- This takes account of the fact that Double might be needed for
566 -- defaulting, but we don't want to load Double (and all its baggage)
567 -- if the more exotic classes aren't used at all.
568 maybe_double | nameUnique cls `elem` fractionalClassKeys
569 = unitFV (getName doubleTyCon)
573 getGates source_fvs (TySynonym tycon tvs ty _)
574 = delListFromNameSet (extractHsTyNames ty)
576 -- A type synonym type constructor isn't a "gate" for instance decls
578 getGates source_fvs (TyData _ ctxt tycon tvs cons _ _ _ _ _)
579 = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
581 `addOneToNameSet` tycon
583 get (ConDecl n _ tvs ctxt details _)
584 | n `elemNameSet` source_fvs
585 -- If the constructor is method, get fvs from all its fields
586 = delListFromNameSet (get_details details `plusFV`
587 extractHsCtxtTyNames ctxt)
589 get (ConDecl n _ tvs ctxt (RecCon fields) _)
590 -- Even if the constructor isn't mentioned, the fields
591 -- might be, as selectors. They can't mention existentially
592 -- bound tyvars (typechecker checks for that) so no need for
593 -- the deleteListFromNameSet part
594 = foldr (plusFV . get_field) emptyFVs fields
596 get other_con = emptyFVs
598 get_details (VanillaCon tys) = plusFVs (map get_bang tys)
599 get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
600 get_details (RecCon fields) = plusFVs [get_bang t | (_, t) <- fields]
602 get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
603 | otherwise = emptyFVs
605 get_bang bty = extractHsTyNames (getBangType bty)
608 @getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
609 rather than a declaration.
612 getWiredInGates :: Name -> FreeVars
613 getWiredInGates name -- No classes are wired in
614 = case lookupNameEnv wiredInThingEnv name of
615 Just (AnId the_id) -> getWiredInGates_s (namesOfType (idType the_id))
619 -> getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
621 (tyvars,ty) = getSynTyConDefn tc
625 getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
629 getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
630 getInstDeclGates other = emptyFVs
634 %*********************************************************
636 \subsection{Getting in a declaration}
638 %*********************************************************
641 importDecl :: Name -> RnMG ImportDeclResult
643 data ImportDeclResult
647 | HereItIs (Module, RdrNameTyClDecl)
650 = -- Check if it was loaded before beginning this module
651 if isLocallyDefined name then
652 returnRn AlreadySlurped
654 checkAlreadyAvailable name `thenRn` \ done ->
656 returnRn AlreadySlurped
659 -- Check if we slurped it in while compiling this module
660 getIfacesRn `thenRn` \ ifaces ->
661 if name `elemNameSet` iSlurp ifaces then
662 returnRn AlreadySlurped
665 -- Don't slurp in decls from this module's own interface file
666 -- (Indeed, this shouldn't happen.)
667 if isLocallyDefined name then
668 addWarnRn (importDeclWarn name) `thenRn_`
669 returnRn AlreadySlurped
672 -- When we find a wired-in name we must load its home
673 -- module so that we find any instance decls lurking therein
674 if name `elemNameEnv` wiredInThingEnv then
675 loadHomeInterface doc name `thenRn_`
678 else getNonWiredInDecl name
680 doc = ptext SLIT("need home module for wired in thing") <+> ppr name
682 getNonWiredInDecl :: Name -> RnMG ImportDeclResult
683 getNonWiredInDecl needed_name
684 = traceRn doc_str `thenRn_`
685 loadHomeInterface doc_str needed_name `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 :: Module
789 -> Bool -- Source unchanged
790 -> Maybe ModIface -- Old interface, if any
791 -> RnMG RecompileRequired
792 recompileRequired mod source_unchanged maybe_iface
793 = traceRn (text "Considering whether compilation is required for" <+> ppr mod <> 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` \ (ifaces, 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 getHomeIfaceTableRn `thenRn` \ hit ->
845 mod_details = lookupTableByModName hit (iPIT ifaces) mod_name
846 `orElse` panic "checkModUsage"
847 new_vers = mi_version mod_details
848 new_decl_vers = vers_decls new_vers
850 case whats_imported of { -- NothingAtAll dealt with earlier
852 Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
854 out_of_date (ptext SLIT("...and I needed the whole module"))
858 Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
861 checkModuleVersion old_mod_vers new_vers `thenRn` \ recompile ->
862 if not recompile then
867 if checkExportList maybe_old_export_vers new_vers then
868 out_of_date (ptext SLIT("Export list changed"))
872 if old_rule_vers /= vers_rules new_vers then
873 out_of_date (ptext SLIT("Rules changed"))
876 -- CHECK ITEMS ONE BY ONE
877 checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers] `thenRn` \ recompile ->
879 returnRn outOfDate -- This one failed, so just bail out now
881 up_to_date (ptext SLIT("...but the bits I use haven't."))
885 doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
887 ------------------------
888 checkModuleVersion old_mod_vers new_vers
889 | vers_module new_vers == old_mod_vers
890 = up_to_date (ptext SLIT("Module version unchanged"))
893 = out_of_date (ptext SLIT("Module version has changed"))
895 ------------------------
896 checkExportList Nothing new_vers = upToDate
897 checkExportList (Just v) new_vers = v /= vers_exports new_vers
899 ------------------------
900 checkEntityUsage new_vers (name,old_vers)
901 = case lookupNameEnv new_vers name of
903 Nothing -> -- We used it before, but it ain't there now
904 out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
906 Just new_vers -- It's there, but is it up to date?
907 | new_vers == old_vers -> returnRn upToDate
908 | otherwise -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])
910 up_to_date msg = traceRn msg `thenRn_` returnRn upToDate
911 out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate
915 %*********************************************************
919 %*********************************************************
923 = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
924 ptext SLIT("from module") <+> quotes (ppr (nameModule name))
929 "Compiler tried to import decl from interface file with same name as module."),
931 "(possible cause: module name clashes with interface file already in scope.)")
933 hsep [ptext SLIT("name:"), quotes (ppr name)]