[project @ 2002-04-29 14:03:38 by simonmar]
[ghc-hetmet.git] / ghc / compiler / rename / RnIfaces.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[RnIfaces]{Cacheing and Renaming of Interfaces}
5
6 \begin{code}
7 module RnIfaces
8      (
9         recordLocalSlurps, 
10         mkImportInfo, 
11
12         slurpImpDecls, closeDecls,
13
14         RecompileRequired, outOfDate, upToDate, recompileRequired
15        )
16 where
17
18 #include "HsVersions.h"
19
20 import CmdLineOpts      ( opt_IgnoreIfacePragmas, opt_NoPruneDecls )
21 import HscTypes
22 import HsSyn            ( HsDecl(..), Sig(..), TyClDecl(..), ConDecl(..), ConDetails(..),
23                           InstDecl(..), HsType(..), hsTyVarNames, getBangType
24                         )
25 import HsImpExp         ( ImportDecl(..) )
26 import RdrHsSyn         ( RdrNameTyClDecl, RdrNameInstDecl, RdrNameRuleDecl )
27 import RnHsSyn          ( RenamedHsDecl, RenamedTyClDecl,
28                           extractHsTyNames, extractHsCtxtTyNames, 
29                           tyClDeclFVs, ruleDeclFVs, instDeclFVs
30                         )
31 import RnHiFiles        ( tryLoadInterface, loadHomeInterface, 
32                           loadOrphanModules
33                         )
34 import RnSource         ( rnTyClDecl, rnInstDecl, rnIfaceRuleDecl )
35 import RnEnv
36 import RnMonad
37 import Id               ( idType, idName, globalIdDetails )
38 import IdInfo           ( GlobalIdDetails(..) )
39 import TcType           ( namesOfType )
40 import FieldLabel       ( fieldLabelTyCon )
41 import DataCon          ( dataConTyCon )
42 import TyCon            ( visibleDataCons, isSynTyCon, getSynTyConDefn, tyConClass_maybe, tyConName )
43 import Class            ( className )
44 import Name             ( Name {-instance NamedThing-}, nameOccName,
45                           nameModule, isInternalName, NamedThing(..)
46                          )
47 import NameEnv          ( elemNameEnv, delFromNameEnv, lookupNameEnv )
48 import NameSet
49 import Module           ( Module, ModuleEnv, 
50                           moduleName, isHomeModule,
51                           ModuleName, WhereFrom(..),
52                           emptyModuleEnv, 
53                           extendModuleEnv_C, foldModuleEnv, lookupModuleEnv,
54                           elemModuleSet, extendModuleSet
55                         )
56 import PrelInfo         ( wiredInThingEnv, hasKey, fractionalClassKey, numClassKey, 
57                           integerTyConName, doubleTyConName )
58 import Maybe            ( isJust )
59 import FiniteMap
60 import Outputable
61 import Bag
62 import Util             ( sortLt )
63 \end{code}
64
65
66 %*********************************************************
67 %*                                                      *
68 \subsection{Keeping track of what we've slurped, and version numbers}
69 %*                                                      *
70 %*********************************************************
71
72 mkImportInfo figures out what the ``usage information'' for this
73 moudule is; that is, what it must record in its interface file as the
74 things it uses.  
75
76 We produce a line for every module B below the module, A, currently being
77 compiled:
78         import B <n> ;
79 to record the fact that A does import B indirectly.  This is used to decide
80 to look to look for B.hi rather than B.hi-boot when compiling a module that
81 imports A.  This line says that A imports B, but uses nothing in it.
82 So we'll get an early bale-out when compiling A if B's version changes.
83
84 The usage information records:
85
86 \begin{itemize}
87 \item   (a) anything reachable from its body code
88 \item   (b) any module exported with a @module Foo@
89 \item   (c) anything reachable from an exported item
90 \end{itemize}
91
92 Why (b)?  Because if @Foo@ changes then this module's export list
93 will change, so we must recompile this module at least as far as
94 making a new interface file --- but in practice that means complete
95 recompilation.
96
97 Why (c)?  Consider this:
98 \begin{verbatim}
99         module A( f, g ) where  |       module B( f ) where
100           import B( f )         |         f = h 3
101           g = ...               |         h = ...
102 \end{verbatim}
103
104 Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
105 @A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
106 *identical* to what it was before.  If anything about @B.f@ changes
107 than anyone who imports @A@ should be recompiled in case they use
108 @B.f@ (they'll get an early exit if they don't).  So, if anything
109 about @B.f@ changes we'd better make sure that something in A.hi
110 changes, and the convenient way to do that is to record the version
111 number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
112 complete recompiation of A, which is overkill but it's the only way to 
113 write a new, slightly different, A.hi.
114
115 But the example is tricker.  Even if @B.f@ doesn't change at all,
116 @B.h@ may do so, and this change may not be reflected in @f@'s version
117 number.  But with -O, a module that imports A must be recompiled if
118 @B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
119 the occurrence of @B.f@ in the export list *just as if* it were in the
120 code of A, and thereby haul in all the stuff reachable from it.
121
122         *** Conclusion: if A mentions B.f in its export list,
123             behave just as if A mentioned B.f in its source code,
124             and slurp in B.f and all its transitive closure ***
125
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.]
129
130 \begin{code}
131 mkImportInfo :: ModuleName                      -- Name of this module
132              -> [ImportDecl n]                  -- The import decls
133              -> RnMG [ImportVersion Name]
134
135 mkImportInfo this_mod imports
136   = getIfacesRn                                 `thenRn` \ ifaces ->
137     getHomeIfaceTableRn                         `thenRn` \ hit -> 
138     let
139         (imp_pkg_mods, imp_home_names) = iVSlurp ifaces
140         pit                            = iPIT    ifaces
141
142         import_all_mods :: [ModuleName]
143                 -- Modules where we imported all the names
144                 -- (apart from hiding some, perhaps)
145         import_all_mods = [ m | ImportDecl m _ _ _ imp_list _ <- imports,
146                                 import_all imp_list ]
147           where
148            import_all (Just (False, _)) = False -- Imports are spec'd explicitly
149            import_all other             = True  -- Everything is imported
150
151         -- mv_map groups together all the things imported and used
152         -- from a particular module in this package
153         -- We use a finite map because we want the domain
154         mv_map :: ModuleEnv [Name]
155         mv_map  = foldNameSet add_mv emptyModuleEnv imp_home_names
156         add_mv name mv_map = extendModuleEnv_C add_item mv_map mod [name]
157                            where
158                              mod = nameModule name
159                              add_item names _ = name:names
160
161         -- In our usage list we record
162         --
163         --      a) Specifically: Detailed version info for imports
164         --         from modules in this package Gotten from iVSlurp plus
165         --         import_all_mods
166         --
167         --      b) Everything: Just the module version for imports
168         --         from modules in other packages Gotten from iVSlurp plus
169         --         import_all_mods
170         --
171         --      c) NothingAtAll: The name only of modules, Baz, in
172         --         this package that are 'below' us, but which we didn't need
173         --         at all (this is needed only to decide whether to open Baz.hi
174         --         or Baz.hi-boot higher up the tree).  This happens when a
175         --         module, Foo, that we explicitly imported has 'import Baz' in
176         --         its interface file, recording that Baz is below Foo in the
177         --         module dependency hierarchy.  We want to propagate this
178         --         info.  These modules are in a combination of HIT/PIT and
179         --         iImpModInfo
180         --
181         --      d) NothingAtAll: The name only of all orphan modules
182         --         we know of (this is needed so that anyone who imports us can
183         --         find the orphan modules) These modules are in a combination
184         --         of HIT/PIT and iImpModInfo
185
186         import_info0 = foldModuleEnv mk_imp_info  []           pit
187         import_info1 = foldModuleEnv mk_imp_info  import_info0 hit
188         import_info  = not_even_opened_imports ++ import_info1
189
190                 -- Recall that iImpModInfo describes modules that have
191                 -- been mentioned in the import lists of interfaces we
192                 -- have opened, but which we have not even opened when
193                 -- compiling this module
194         not_even_opened_imports =
195           [ (mod_name, orphans, is_boot, NothingAtAll) 
196           | (mod_name, (orphans, is_boot)) <- fmToList (iImpModInfo ifaces) ]
197
198         
199         mk_imp_info :: ModIface -> [ImportVersion Name] -> [ImportVersion Name]
200         mk_imp_info iface so_far
201
202           | Just ns <- lookupModuleEnv mv_map mod       -- Case (a)
203           = go_for_it (Specifically mod_vers maybe_export_vers 
204                                     (mk_import_items ns) rules_vers)
205
206           | mod `elemModuleSet` imp_pkg_mods            -- Case (b)
207           = go_for_it (Everything mod_vers)
208
209           | import_all_mod                              -- Case (a) and (b); the import-all part
210           = if is_home_pkg_mod then
211                 go_for_it (Specifically mod_vers (Just export_vers) [] rules_vers)
212                 -- Since the module isn't in the mv_map, presumably we
213                 -- didn't actually import anything at all from it
214             else
215                 go_for_it (Everything mod_vers)
216                 
217           | is_home_pkg_mod || has_orphans              -- Case (c) or (d)
218           = go_for_it NothingAtAll
219
220           | otherwise = so_far
221           where
222             go_for_it exports = (mod_name, has_orphans, mi_boot iface, exports) : so_far
223
224             mod             = mi_module iface
225             mod_name        = moduleName mod
226             is_home_pkg_mod = isHomeModule mod
227             version_info    = mi_version iface
228             version_env     = vers_decls   version_info
229             mod_vers        = vers_module  version_info
230             rules_vers      = vers_rules   version_info
231             export_vers     = vers_exports version_info
232             import_all_mod  = mod_name `elem` import_all_mods
233             has_orphans     = mi_orphan iface
234             
235                 -- The sort is to put them into canonical order
236             mk_import_items ns = [(n,v) | n <- sortLt lt_occ ns, 
237                                           let v = lookupVersion version_env n
238                                  ]
239                          where
240                            lt_occ n1 n2 = nameOccName n1 < nameOccName n2
241
242             maybe_export_vers | import_all_mod = Just (vers_exports version_info)
243                               | otherwise      = Nothing
244     in
245     returnRn import_info
246 \end{code}
247
248 %*********************************************************
249 %*                                                       *
250 \subsection{Slurping declarations}
251 %*                                                       *
252 %*********************************************************
253
254 \begin{code}
255 -------------------------------------------------------
256 slurpImpDecls source_fvs
257   = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`
258
259         -- The current slurped-set records all local things
260     slurpSourceRefs source_fvs  `thenRn` \ (decls, needed) ->
261
262         -- Then get everything else
263     closeDecls decls needed
264
265
266 -------------------------------------------------------
267 slurpSourceRefs :: 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
272
273 slurpSourceRefs 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
278   where
279         -- The outer loop repeatedly slurps the decls for the current gates
280         -- and the instance decls 
281
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.
286         --
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.
292
293     go_outer decls fvs all_gates []     
294         = returnRn (decls, fvs)
295
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           rnIfaceInstDecls 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
305                 -- and we get an infinite loop
306
307     go_inner (decls, fvs, gates) wanted_name
308         = importDecl wanted_name                `thenRn` \ import_result ->
309           case import_result of
310             AlreadySlurped     -> returnRn (decls, fvs, gates)
311             InTypeEnv ty_thing -> returnRn (decls, fvs, gates `plusFV` getWiredInGates ty_thing)
312                         
313             HereItIs decl -> rnIfaceTyClDecl decl               `thenRn` \ (new_decl, fvs1) ->
314                              returnRn (TyClD new_decl : decls, 
315                                        fvs1 `plusFV` fvs,
316                                        gates `plusFV` getGates source_fvs new_decl)
317 \end{code}
318
319
320 \begin{code}
321 -------------------------------------------------------
322 -- closeDecls keeps going until the free-var set is empty
323 closeDecls decls needed
324   = slurpIfaceDecls decls needed        `thenRn` \ decls1 ->
325     getImportedRules                    `thenRn` \ rule_decls ->
326     case rule_decls of
327         []    -> returnRn decls1        -- No new rules, so we are done
328         other -> rnIfaceDecls rnIfaceRuleDecl rule_decls        `thenRn` \ rule_decls' ->
329                  let
330                         rule_fvs = plusFVs (map ruleDeclFVs rule_decls')
331                  in
332                  traceRn (text "closeRules" <+> ppr rule_decls' $$ 
333                           fsep (map ppr (nameSetToList rule_fvs)))      `thenRn_`
334                  closeDecls (map RuleD rule_decls' ++ decls1) rule_fvs
335                  
336
337 -------------------------------------------------------
338 -- Augment decls with any decls needed by needed,
339 -- and so on transitively
340 slurpIfaceDecls :: [RenamedHsDecl] -> FreeVars -> RnMG [RenamedHsDecl]
341 slurpIfaceDecls decls needed
342   = slurp decls (nameSetToList needed) 
343   where
344     slurp decls []     = returnRn decls
345     slurp decls (n:ns) = slurp_one decls n      `thenRn` \ decls1 ->
346                          slurp decls1 ns
347
348     slurp_one decls wanted_name
349       = importDecl wanted_name          `thenRn` \ import_result ->
350         case import_result of
351           HereItIs decl ->      -- Found a declaration... rename it
352                                 -- and get the things it needs
353                    rnIfaceTyClDecl decl         `thenRn` \ (new_decl, fvs) ->
354                    slurp (TyClD new_decl : decls) (nameSetToList fvs)
355   
356           
357           other ->      -- No declaration... (wired in thing, or deferred, 
358                         --      or already slurped)
359                    returnRn decls
360
361
362 -------------------------------------------------------
363 rnIfaceDecls rn decls      = mapRn (rnIfaceDecl rn) decls
364 rnIfaceDecl rn (mod, decl) = initIfaceRnMS mod (rn decl)        
365
366 rnIfaceInstDecls decls fvs gates inst_decls
367   = rnIfaceDecls rnInstDecl inst_decls  `thenRn` \ inst_decls' ->
368     returnRn (map InstD inst_decls' ++ decls,
369               fvs `plusFV` plusFVs (map instDeclFVs inst_decls'),
370               gates `plusFV` plusFVs (map getInstDeclGates inst_decls'))
371
372 rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl)       `thenRn` \ decl' ->
373                               returnRn (decl', tyClDeclFVs decl')
374 \end{code}
375
376
377 \begin{code}
378 recordDeclSlurp ifaces@(Ifaces { iDecls  = (decls_map, n_slurped),
379                                  iSlurp  = slurped_names, 
380                                  iVSlurp = vslurp })
381             avail
382   = ASSERT2( not (isInternalName (availName avail)), ppr avail )
383     ifaces { iDecls = (new_decls_map, n_slurped+1),
384              iSlurp  = new_slurped_names, 
385              iVSlurp = updateVSlurp vslurp (availName avail) }
386   where
387     new_decls_map     = foldl delFromNameEnv decls_map (availNames avail)
388     new_slurped_names = addAvailToNameSet slurped_names avail
389
390
391 -- recordTypeEnvSlurp is used when we slurp something that's
392 -- already in the type environment, that was not slurped in an earlier compilation.
393 -- We record it in the iVSlurp set, because that's used to
394 -- generate usage information
395
396 recordTypeEnvSlurp ifaces ty_thing
397   = ifaces { iVSlurp = updateVSlurp (iVSlurp ifaces) (get_main_name ty_thing) }
398   where
399         -- Tiresomely, we must get the "main" name for the 
400         -- thing, because that's what VSlurp contains, and what
401         -- is recorded in the usage information
402     get_main_name (AClass cl) = className cl
403     get_main_name (ATyCon tc)
404         | Just clas <- tyConClass_maybe tc = get_main_name (AClass clas)
405         | otherwise                        = tyConName tc
406     get_main_name (AnId id)
407         = case globalIdDetails id of
408             DataConId     dc -> get_main_name (ATyCon (dataConTyCon dc))
409             DataConWrapId dc -> get_main_name (ATyCon (dataConTyCon dc))
410             RecordSelId lbl  -> get_main_name (ATyCon (fieldLabelTyCon lbl))
411             other            -> idName id
412
413 updateVSlurp (imp_mods, imp_names) main_name
414   | isHomeModule mod = (imp_mods,                     addOneToNameSet imp_names main_name)
415   | otherwise        = (extendModuleSet imp_mods mod, imp_names)
416   where
417     mod = nameModule main_name
418   
419 recordLocalSlurps new_names
420   = getIfacesRn         `thenRn` \ ifaces ->
421     setIfacesRn (ifaces { iSlurp  = iSlurp ifaces `unionNameSets` new_names })
422 \end{code}
423
424
425
426 %*********************************************************
427 %*                                                       *
428 \subsection{Extracting the `gates'}
429 %*                                                       *
430 %*********************************************************
431
432 The gating story
433 ~~~~~~~~~~~~~~~~~
434 We want to avoid sucking in too many instance declarations.
435 An instance decl is only useful if the types and classes mentioned in
436 its 'head' are all available in the program being compiled.  E.g.
437
438         instance (..) => C (T1 a) (T2 b) where ...
439
440 is only useful if C, T1 and T2 are all "available".  So we keep
441 instance decls that have been parsed from .hi files, but not yet
442 slurped in, in a pool called the 'gated instance pool'.
443 Each has its set of 'gates': {C, T1, T2} in the above example.
444
445 More precisely, the gates of a module are the types and classes 
446 that are mentioned in:
447
448         a) the source code
449         b) the type of an Id that's mentioned in the source code
450            [includes constructors and selectors]
451         c) the RHS of a type synonym that is a gate
452         d) the superclasses of a class that is a gate
453         e) the context of an instance decl that is slurped in
454
455 We slurp in an instance decl from the gated instance pool iff
456         
457         all its gates are either in the gates of the module, 
458         or are a previously-loaded tycon or class.  
459
460 The latter constraint is because there might have been an instance
461 decl slurped in during an earlier compilation, like this:
462
463         instance Foo a => Baz (Maybe a) where ...
464
465 In the module being compiled we might need (Baz (Maybe T)), where T
466 is defined in this module, and hence we need (Foo T).  So @Foo@ becomes
467 a gate.  But there's no way to 'see' that.  More generally, types
468 might be involved as well:
469
470         instance Foo2 T a => Baz2 a where ...
471
472 Now we must treat T as a gate too, as well as Foo.  So the solution
473 we adopt is:
474
475         we simply treat all previously-loaded 
476         tycons and classes as gates.
477
478 This gloss only affects ghc --make and ghc --interactive.
479
480
481 Consructors and class operations
482 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
483 When we import a declaration like
484
485         data T = T1 Wibble | T2 Wobble
486
487 we don't want to treat @Wibble@ and @Wobble@ as gates {\em unless}
488 @T1@, @T2@ respectively are mentioned by the user program. If only
489 @T@ is mentioned we want only @T@ to be a gate; that way we don't suck
490 in useless instance decls for (say) @Eq Wibble@, when they can't
491 possibly be useful.
492
493 And that's just what (b) says: we only treat T1's type as a gate if
494 T1 is mentioned.  getGates, which deals with decls we are slurping in,
495 has to be a bit careful, because a mention of T1 will slurp in T's whole
496 declaration.
497
498 -----------------------------
499 @getGates@ takes a newly imported (and renamed) decl, and the free
500 vars of the source program, and extracts from the decl the gate names.
501
502 \begin{code}
503 getGates :: FreeVars            -- Things mentioned in the source program
504                                 -- Used for the cunning "constructors and 
505                                 -- class ops" story described 10 lines above.
506          -> RenamedTyClDecl
507          -> FreeVars
508
509 getGates source_fvs decl 
510   = get_gates (\n -> n `elemNameSet` source_fvs) decl
511
512 get_gates is_used (ForeignType {tcdName = tycon}) = unitNameSet tycon
513 get_gates is_used (IfaceSig    {tcdType = ty})    = extractHsTyNames ty
514 get_gates is_used (CoreDecl    {tcdType = ty})    = extractHsTyNames ty
515
516 get_gates is_used (ClassDecl { tcdCtxt = ctxt, tcdName = cls, tcdTyVars = tvs, tcdSigs = sigs})
517   = (super_cls_and_sigs `addOneToNameSet` cls) `unionNameSets` 
518     implicitClassGates cls
519   where
520     super_cls_and_sigs = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
521                                             (hsTyVarNames tvs)
522     get (ClassOpSig n _ ty _) 
523         | is_used n = extractHsTyNames ty
524         | otherwise = emptyFVs
525
526 get_gates is_used (TySynonym {tcdTyVars = tvs, tcdSynRhs = ty})
527   = delListFromNameSet (extractHsTyNames ty) (hsTyVarNames tvs)
528         -- A type synonym type constructor isn't a "gate" for instance decls
529
530 get_gates is_used (TyData {tcdCtxt = ctxt, tcdName = tycon, tcdTyVars = tvs, tcdCons = cons})
531   = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) 
532                                              (visibleDataCons cons))
533                        (hsTyVarNames tvs)
534     `addOneToNameSet` tycon
535   where
536     get (ConDecl n _ tvs ctxt details _)
537         | is_used n
538                 -- If the constructor is method, get fvs from all its fields
539         = delListFromNameSet (get_details details `plusFV` 
540                               extractHsCtxtTyNames ctxt)
541                              (hsTyVarNames tvs)
542     get (ConDecl n _ tvs ctxt (RecCon fields) _)
543                 -- Even if the constructor isn't mentioned, the fields
544                 -- might be, as selectors.  They can't mention existentially
545                 -- bound tyvars (typechecker checks for that) so no need for 
546                 -- the deleteListFromNameSet part
547         = foldr (plusFV . get_field) emptyFVs fields
548         
549     get other_con = emptyFVs
550
551     get_details (VanillaCon tys) = plusFVs (map get_bang tys)
552     get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
553     get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]
554
555     get_field (fs,t) | any is_used fs = get_bang t
556                      | otherwise      = emptyFVs
557
558     get_bang bty = extractHsTyNames (getBangType bty)
559
560 implicitClassGates :: Name -> FreeVars
561 implicitClassGates cls
562         -- If we load class Num, add Integer to the free gates
563         -- This takes account of the fact that Integer might be needed for
564         -- defaulting, but we don't want to load Integer (and all its baggage)
565         -- if there's no numeric stuff needed.
566         -- Similarly for class Fractional and Double
567         --
568         -- NB: adding T to the gates will force T to be loaded
569         --
570         -- NB: If we load (say) Floating, we'll end up loading Fractional too,
571         --     since Fractional is a superclass of Floating
572   | cls `hasKey` numClassKey        = unitFV integerTyConName
573   | cls `hasKey` fractionalClassKey = unitFV doubleTyConName
574   | otherwise                       = emptyFVs
575 \end{code}
576
577 @getWiredInGates@ is just like @getGates@, but it sees a previously-loaded
578 thing rather than a declaration.
579
580 \begin{code}
581 getWiredInGates :: TyThing -> FreeVars
582 -- The TyThing is one that we already have in our type environment, either
583 --      a) because the TyCon or Id is wired in, or
584 --      b) from a previous compile
585 -- Either way, we might have instance decls in the (persistent) collection
586 -- of parsed-but-not-slurped instance decls that should be slurped in.
587 -- This might be the first module that mentions both the type and the class
588 -- for that instance decl, even though both the type and the class were
589 -- mentioned in other modules, and hence are in the type environment
590
591 getWiredInGates (AnId the_id) = namesOfType (idType the_id)
592 getWiredInGates (AClass cl)   = implicitClassGates (getName cl)
593         -- The superclasses must also be previously
594         -- loaded, and hence are automatically gates
595         -- All previously-loaded classes are automatically gates
596         -- See "The gating story" above
597 getWiredInGates (ATyCon tc)
598   | isSynTyCon tc = delListFromNameSet (namesOfType ty) (map getName tyvars)
599   | otherwise     = unitFV (getName tc)
600   where
601     (tyvars,ty)  = getSynTyConDefn tc
602
603 getInstDeclGates (InstDecl inst_ty _ _ _ _) = extractHsTyNames inst_ty
604 \end{code}
605
606 \begin{code}
607 getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameInstDecl)]
608 getImportedInstDecls gates
609   =     -- First, load any orphan-instance modules that aren't aready loaded
610         -- Orphan-instance modules are recorded in the module dependecnies
611     getIfacesRn                                         `thenRn` \ ifaces ->
612     let
613         orphan_mods =
614           [mod | (mod, (True, _)) <- fmToList (iImpModInfo ifaces)]
615     in
616     loadOrphanModules orphan_mods                       `thenRn_` 
617
618         -- Now we're ready to grab the instance declarations
619         -- Find the un-gated ones and return them, 
620         -- removing them from the bag kept in Ifaces
621     getIfacesRn                                         `thenRn` \ ifaces ->
622     getTypeEnvRn                                        `thenRn` \ lookup ->
623     let
624         available n = n `elemNameSet` gates || isJust (lookup n)
625                 -- See "The gating story" above for the isJust thing
626
627         (decls, new_insts) = selectGated available (iInsts ifaces)
628     in
629     setIfacesRn (ifaces { iInsts = new_insts })         `thenRn_`
630
631     traceRn (sep [text "getImportedInstDecls:", 
632                   nest 4 (fsep (map ppr gate_list)),
633                   text "Slurped" <+> int (length decls) <+> text "instance declarations",
634                   nest 4 (vcat (map ppr_brief_inst_decl decls))])       `thenRn_`
635     returnRn decls
636   where
637     gate_list      = nameSetToList gates
638
639 ppr_brief_inst_decl (mod, InstDecl inst_ty _ _ _ _)
640   = case inst_ty of
641         HsForAllTy _ _ tau -> ppr tau
642         other              -> ppr inst_ty
643
644 getImportedRules :: RnMG [(Module,RdrNameRuleDecl)]
645 getImportedRules 
646   | opt_IgnoreIfacePragmas = returnRn []
647   | otherwise
648   = getIfacesRn         `thenRn` \ ifaces ->
649     getTypeEnvRn        `thenRn` \ lookup ->
650     let
651                 -- Slurp rules for anything that is slurped, 
652                 -- either now or previously
653         gates              = iSlurp ifaces      
654         available n        = n `elemNameSet` gates || isJust (lookup n)
655         (decls, new_rules) = selectGated available (iRules ifaces)
656     in
657     if null decls then
658         returnRn []
659     else
660     setIfacesRn (ifaces { iRules = new_rules })              `thenRn_`
661     traceRn (sep [text "getImportedRules:", 
662                   text "Slurped" <+> int (length decls) <+> text "rules"])   `thenRn_`
663     returnRn decls
664
665 selectGated :: (Name->Bool) -> GatedDecls d
666             -> ([(Module,d)], GatedDecls d)
667 selectGated available (decl_bag, n_slurped)
668         -- Select only those decls whose gates are *all* available
669 #ifdef DEBUG
670   | opt_NoPruneDecls    -- Just to try the effect of not gating at all
671   = let
672         decls = foldrBag (\ (_,d) ds -> d:ds) [] decl_bag       -- Grab them all
673     in
674     (decls, (emptyBag, n_slurped + length decls))
675
676   | otherwise
677 #endif
678   = case foldrBag select ([], emptyBag) decl_bag of
679         (decls, new_bag) -> (decls, (new_bag, n_slurped + length decls))
680   where
681     select (gate_fn, decl) (yes, no)
682         | gate_fn available  = (decl:yes, no)
683         | otherwise          = (yes,      (gate_fn,decl) `consBag` no)
684 \end{code}
685
686
687 %*********************************************************
688 %*                                                      *
689 \subsection{Getting in a declaration}
690 %*                                                      *
691 %*********************************************************
692
693 \begin{code}
694 importDecl :: Name -> RnMG ImportDeclResult
695
696 data ImportDeclResult
697   = AlreadySlurped
698   | InTypeEnv TyThing
699   | HereItIs (Module, RdrNameTyClDecl)
700
701 importDecl name
702   =     -- STEP 1: Check if we've slurped it in while compiling this module
703     getIfacesRn                         `thenRn` \ ifaces ->
704     if name `elemNameSet` iSlurp ifaces then    
705         returnRn AlreadySlurped 
706     else
707
708
709         -- STEP 2: Check if it's already in the type environment
710     getTypeEnvRn                        `thenRn` \ lookup ->
711     case lookup name of {
712         Just ty_thing 
713             |   name `elemNameEnv` wiredInThingEnv
714             ->  -- When we find a wired-in name we must load its home
715                 -- module so that we find any instance decls lurking therein
716                 loadHomeInterface wi_doc name   `thenRn_`
717                 returnRn (InTypeEnv ty_thing)
718
719             |   otherwise
720             ->  -- Very important: record that we've seen it
721                 -- See comments with recordTypeEnvSlurp
722                 setIfacesRn (recordTypeEnvSlurp ifaces ty_thing)        `thenRn_`
723                 returnRn (InTypeEnv ty_thing) ;
724
725         Nothing -> 
726
727         -- STEP 3: OK, we have to slurp it in from an interface file
728         --         First load the interface file
729     traceRn nd_doc                      `thenRn_`
730     loadHomeInterface nd_doc name       `thenRn_`
731     getIfacesRn                         `thenRn` \ ifaces ->
732
733         -- STEP 4: Get the declaration out
734     let
735         (decls_map, _) = iDecls ifaces
736     in
737     case lookupNameEnv decls_map name of
738       Just (avail,_,decl) -> setIfacesRn (recordDeclSlurp ifaces avail) `thenRn_`
739                              returnRn (HereItIs decl)
740
741       Nothing -> addErrRn (getDeclErr name)     `thenRn_` 
742                  returnRn AlreadySlurped
743     }
744   where
745     wi_doc = ptext SLIT("need home module for wired in thing") <+> ppr name
746     nd_doc = ptext SLIT("need decl for") <+> ppr name
747
748 \end{code}
749
750
751 %********************************************************
752 %*                                                      *
753 \subsection{Checking usage information}
754 %*                                                      *
755 %********************************************************
756
757 @recompileRequired@ is called from the HscMain.   It checks whether
758 a recompilation is required.  It needs access to the persistent state,
759 finder, etc, because it may have to load lots of interface files to
760 check their versions.
761
762 \begin{code}
763 type RecompileRequired = Bool
764 upToDate  = False       -- Recompile not required
765 outOfDate = True        -- Recompile required
766
767 recompileRequired :: FilePath           -- Only needed for debug msgs
768                   -> ModIface           -- Old interface
769                   -> RnMG RecompileRequired
770 recompileRequired iface_path iface
771   = traceHiDiffsRn (text "Considering whether compilation is required for" <+> text iface_path <> colon)        `thenRn_`
772
773         -- Source code unchanged and no errors yet... carry on 
774     checkList [checkModUsage u | u <- mi_usages iface]
775
776 checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
777 checkList []             = returnRn upToDate
778 checkList (check:checks) = check        `thenRn` \ recompile ->
779                            if recompile then 
780                                 returnRn outOfDate
781                            else
782                                 checkList checks
783 \end{code}
784         
785 \begin{code}
786 checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
787 -- Given the usage information extracted from the old
788 -- M.hi file for the module being compiled, figure out
789 -- whether M needs to be recompiled.
790
791 checkModUsage (mod_name, _, _, NothingAtAll)
792         -- If CurrentModule.hi contains 
793         --      import Foo :: ;
794         -- then that simply records that Foo lies below CurrentModule in the
795         -- hierarchy, but CurrentModule doesn't depend in any way on Foo.
796         -- In this case we don't even want to open Foo's interface.
797   = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)
798
799 checkModUsage (mod_name, _, is_boot, whats_imported)
800   =     -- Load the imported interface is possible
801         -- We use tryLoadInterface, because failure is not an error
802         -- (might just be that the old .hi file for this module is out of date)
803         -- We use ImportByUser/ImportByUserSource as the 'from' flag, 
804         --      a) because we need to know whether to load the .hi-boot file
805         --      b) because loadInterface things matters are amiss if we 
806         --         ImportBySystem an interface it knows nothing about
807     let
808         doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]
809         from    | is_boot   = ImportByUserSource
810                 | otherwise = ImportByUser
811     in
812     traceHiDiffsRn (text "Checking usages for module" <+> ppr mod_name) `thenRn_`
813     tryLoadInterface doc_str mod_name from      `thenRn` \ (iface, maybe_err) ->
814
815     case maybe_err of {
816         Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"), 
817                                       ppr mod_name]) ;
818                 -- Couldn't find or parse a module mentioned in the
819                 -- old interface file.  Don't complain -- it might just be that
820                 -- the current module doesn't need that import and it's been deleted
821
822         Nothing -> 
823     let
824         new_vers      = mi_version iface
825         new_decl_vers = vers_decls new_vers
826     in
827     case whats_imported of {    -- NothingAtAll dealt with earlier
828
829       Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers       `thenRn` \ recompile ->
830                                  if recompile then
831                                         out_of_date (ptext SLIT("...and I needed the whole module"))
832                                  else
833                                         returnRn upToDate ;
834
835       Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->
836
837         -- CHECK MODULE
838     checkModuleVersion old_mod_vers new_vers    `thenRn` \ recompile ->
839     if not recompile then
840         returnRn upToDate
841     else
842                                  
843         -- CHECK EXPORT LIST
844     if checkExportList maybe_old_export_vers new_vers then
845         out_of_date (ptext SLIT("Export list changed"))
846     else
847
848         -- CHECK RULES
849     if old_rule_vers /= vers_rules new_vers then
850         out_of_date (ptext SLIT("Rules changed"))
851     else
852
853         -- CHECK ITEMS ONE BY ONE
854     checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]   `thenRn` \ recompile ->
855     if recompile then
856         returnRn outOfDate      -- This one failed, so just bail out now
857     else
858         up_to_date (ptext SLIT("...but the bits I use haven't."))
859
860     }}
861
862 ------------------------
863 checkModuleVersion old_mod_vers new_vers
864   | vers_module new_vers == old_mod_vers
865   = up_to_date (ptext SLIT("Module version unchanged"))
866
867   | otherwise
868   = out_of_date (ptext SLIT("Module version has changed"))
869
870 ------------------------
871 checkExportList Nothing  new_vers = upToDate
872 checkExportList (Just v) new_vers = v /= vers_exports new_vers
873
874 ------------------------
875 checkEntityUsage new_vers (name,old_vers)
876   = case lookupNameEnv new_vers name of
877
878         Nothing       ->        -- We used it before, but it ain't there now
879                           out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])
880
881         Just new_vers   -- It's there, but is it up to date?
882           | new_vers == old_vers -> traceHiDiffsRn (text "Up to date" <+> ppr name <+> parens (ppr new_vers)) `thenRn_`
883                                     returnRn upToDate
884           | otherwise            -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name, ppr 
885                                                       old_vers, ptext SLIT("->"), ppr new_vers])
886
887 up_to_date  msg = traceHiDiffsRn msg `thenRn_` returnRn upToDate
888 out_of_date msg = traceHiDiffsRn msg `thenRn_` returnRn outOfDate
889 \end{code}
890
891
892 %*********************************************************
893 %*                                                       *
894 \subsection{Errors}
895 %*                                                       *
896 %*********************************************************
897
898 \begin{code}
899 getDeclErr name
900   = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
901           ptext SLIT("from module") <+> quotes (ppr (nameModule name))
902          ]
903 \end{code}