RnIfaces.lhs 31.9 KB
Newer Older
1
%
2
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3
4
5
6
%
\section[RnIfaces]{Cacheing and Renaming of Interfaces}

\begin{code}
7
module RnIfaces
8
     (
9
	getInterfaceExports,
10
11
12
13
	recordLocalSlurps, 
	mkImportInfo, 

	slurpImpDecls, 
14

15
	RecompileRequired, outOfDate, upToDate, recompileRequired
16
17
       )
where
18

19
#include "HsVersions.h"
20

21
import CmdLineOpts	( DynFlags, opt_NoPruneDecls, opt_NoPruneTyDecls, opt_IgnoreIfacePragmas )
22
import HscTypes
23
import HsSyn		( HsDecl(..), InstDecl(..),  HsType(..) )
24
import HsImpExp		( ImportDecl(..) )
25
import BasicTypes	( Version, defaultFixity )
26
27
28
29
import RdrHsSyn		( RdrNameHsDecl, RdrNameTyClDecl, RdrNameInstDecl )
import RnHiFiles	( tryLoadInterface, loadHomeInterface, loadInterface, 
			  loadOrphanModules
			)
30
import RnSource		( rnTyClDecl, rnDecl )
31
import RnEnv
32
import RnMonad
33
34
import Name		( Name {-instance NamedThing-}, nameOccName,
			  nameModule, isLocallyDefined, 
35
			  NamedThing(..),
36
			  elemNameEnv
37
			 )
38
import Module		( Module, ModuleEnv,
39
			  moduleName, isModuleInThisPackage,
40
			  ModuleName, WhereFrom(..),
41
			  emptyModuleEnv, lookupModuleEnvByName,
42
			  extendModuleEnv_C, lookupWithDefaultModuleEnv
43
			)
44
import NameSet
45
import PrelInfo		( wiredInThingEnv )
46
import Maybes		( orElse )
47
import FiniteMap
sof's avatar
sof committed
48
import Outputable
49
import Bag
50

51
import List		( nub )
52
53
\end{code}

54

55
56
%*********************************************************
%*							*
sof's avatar
sof committed
57
\subsection{Getting what a module exports}
58
59
%*							*
%*********************************************************
60

61
@getInterfaceExports@ is called only for directly-imported modules.
62

63
\begin{code}
64
65
getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, Avails)
getInterfaceExports mod_name from
66
67
68
69
70
71
72
73
74
75
76
  = getHomeIfaceTableRn 		`thenRn` \ hit ->
    case lookupModuleEnvByName hit mod_name of {
	Just mi -> returnRn (mi_module mi, mi_exports mi) ;
        Nothing  -> 

    loadInterface doc_str mod_name from	`thenRn` \ ifaces ->
    case lookupModuleEnvByName (iPIT ifaces) mod_name of
	Just mi -> returnRn (mi_module mi, mi_exports mi) ;
		-- loadInterface always puts something in the map
		-- even if it's a fake
	Nothing -> pprPanic "getInterfaceExports" (ppr mod_name)
77
78
    }
    where
79
      doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")]
sof's avatar
sof committed
80
81
82
83
84
\end{code}


%*********************************************************
%*							*
85
\subsection{Instance declarations are handled specially}
sof's avatar
sof committed
86
87
88
89
%*							*
%*********************************************************

\begin{code}
90
91
getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
getImportedInstDecls gates
92
  =    	-- First, load any orphan-instance modules that aren't aready loaded
93
	-- Orphan-instance modules are recorded in the module dependecnies
94
    getIfacesRn 					`thenRn` \ ifaces ->
sof's avatar
sof committed
95
    let
96
	orphan_mods =
97
	  [mod | (mod, (True, _, False)) <- fmToList (iImpModInfo ifaces)]
sof's avatar
sof committed
98
    in
99
    loadOrphanModules orphan_mods			`thenRn_` 
100

101
	-- Now we're ready to grab the instance declarations
102
103
	-- Find the un-gated ones and return them, 
	-- removing them from the bag kept in Ifaces
104
    getIfacesRn 					`thenRn` \ ifaces ->
105
    let
106
107
108
	(decls, new_insts) = selectGated gates (iInsts ifaces)
    in
    setIfacesRn (ifaces { iInsts = new_insts })		`thenRn_`
109

110
    traceRn (sep [text "getImportedInstDecls:", 
111
		  nest 4 (fsep (map ppr gate_list)),
112
113
		  text "Slurped" <+> int (length decls) <+> text "instance declarations",
		  nest 4 (vcat (map ppr_brief_inst_decl decls))])	`thenRn_`
114
115
    returnRn decls
  where
116
117
    gate_list      = nameSetToList gates

118
119
120
121
122
ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
  = case inst_ty of
	HsForAllTy _ _ tau -> ppr tau
	other		   -> ppr inst_ty

123
getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
124
125
126
getImportedRules 
  | opt_IgnoreIfacePragmas = returnRn []
  | otherwise
127
128
129
  = getIfacesRn 	`thenRn` \ ifaces ->
    let
	gates		   = iSlurp ifaces	-- Anything at all that's been slurped
130
131
	rules		   = iRules ifaces
	(decls, new_rules) = selectGated gates rules
132
    in
133
134
135
136
    if null decls then
	returnRn []
    else
    setIfacesRn (ifaces { iRules = new_rules })		     `thenRn_`
137
    traceRn (sep [text "getImportedRules:", 
138
		  text "Slurped" <+> int (length decls) <+> text "rules"])   `thenRn_`
139
    returnRn decls
140

141
selectGated gates decl_bag
142
	-- Select only those decls whose gates are *all* in 'gates'
143
144
145
#ifdef DEBUG
  | opt_NoPruneDecls	-- Just to try the effect of not gating at all
  = (foldrBag (\ (_,d) ds -> d:ds) [] decl_bag, emptyBag)	-- Grab them all
146

147
148
149
  | otherwise
#endif
  = foldrBag select ([], emptyBag) decl_bag
150
  where
151
152
153
    select (reqd, decl) (yes, no)
	| isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
	| otherwise				     = (yes,      (reqd,decl) `consBag` no)
154
155
\end{code}

sof's avatar
sof committed
156
157
158
159
160
161
162

%*********************************************************
%*							*
\subsection{Keeping track of what we've slurped, and version numbers}
%*							*
%*********************************************************

163
164
165
166
getImportVersions figures out what the ``usage information'' for this
moudule is; that is, what it must record in its interface file as the
things it uses.  It records:

167
\begin{itemize}
168
169
170
\item	(a) anything reachable from its body code
\item	(b) any module exported with a @module Foo@
\item   (c) anything reachable from an exported item
171
\end{itemize}
172
173

Why (b)?  Because if @Foo@ changes then this module's export list
174
175
176
177
will change, so we must recompile this module at least as far as
making a new interface file --- but in practice that means complete
recompilation.

178
Why (c)?  Consider this:
179
180
181
182
183
\begin{verbatim}
	module A( f, g ) where	|	module B( f ) where
	  import B( f )		|	  f = h 3
	  g = ...		|	  h = ...
\end{verbatim}
184

185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
@A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
*identical* to what it was before.  If anything about @B.f@ changes
than anyone who imports @A@ should be recompiled in case they use
@B.f@ (they'll get an early exit if they don't).  So, if anything
about @B.f@ changes we'd better make sure that something in A.hi
changes, and the convenient way to do that is to record the version
number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
complete recompiation of A, which is overkill but it's the only way to 
write a new, slightly different, A.hi.

But the example is tricker.  Even if @B.f@ doesn't change at all,
@B.h@ may do so, and this change may not be reflected in @f@'s version
number.  But with -O, a module that imports A must be recompiled if
@B.h@ changes!  So A must record a dependency on @B.h@.  So we treat
the occurrence of @B.f@ in the export list *just as if* it were in the
code of A, and thereby haul in all the stuff reachable from it.

[NB: If B was compiled with -O, but A isn't, we should really *still*
haul in all the unfoldings for B, in case the module that imports A *is*
compiled with -O.  I think this is the case.]

Even if B is used at all we get a usage line for B
	import B <n> :: ... ;
209
210
211
212
in A.hi, to record the fact that A does import B.  This is used to decide
to look to look for B.hi rather than B.hi-boot when compiling a module that
imports A.  This line says that A imports B, but uses nothing in it.
So we'll get an early bale-out when compiling A if B's version changes.
213

214
\begin{code}
215
216
217
218
219
mkImportInfo :: ModuleName			-- Name of this module
	     -> [ImportDecl n]			-- The import decls
	     -> RnMG [ImportVersion Name]

mkImportInfo this_mod imports
220
  = getIfacesRn					`thenRn` \ ifaces ->
221
    getHomeIfaceTableRn				`thenRn` \ hit -> 
222
    let
223
224
225
	import_all_mods :: [ModuleName]
		-- Modules where we imported all the names
		-- (apart from hiding some, perhaps)
226
227
	import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports,
				    import_all imp_list ]
228
229
230

	import_all (Just (False, _)) = False	-- Imports are specified explicitly
	import_all other	     = True	-- Everything is imported
231

232
233
	mod_map   = iImpModInfo ifaces
	imp_names = iVSlurp     ifaces
234
	pit	  = iPIT 	ifaces
235

236
	-- mv_map groups together all the things imported from a particular module.
237
	mv_map :: ModuleEnv [Name]
238
	mv_map = foldr add_mv emptyModuleEnv imp_names
239

240
        add_mv name mv_map = addItem mv_map (nameModule name) name
241

242
	-- Build the result list by adding info for each module.
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
	-- For (a) a library module, we don't record it at all unless it contains orphans
	-- 	   (We must never lose track of orphans.)
	-- 
	--     (b) a source-imported module, don't record the dependency at all
	--	
	-- (b) may seem a bit strange.  The idea is that the usages in a .hi file records
	-- *all* the module's dependencies other than the loop-breakers.  We use
	-- this info in findAndReadInterface to decide whether to look for a .hi file or
	-- a .hi-boot file.  
	--
	-- This means we won't track version changes, or orphans, from .hi-boot files.
	-- The former is potentially rather bad news.  It could be fixed by recording
	-- whether something is a boot file along with the usage info for it, but 
	-- I can't be bothered just now.

258
	mk_imp_info mod_name (has_orphans, is_boot, opened) so_far
259
260
261
262
263
264
	   | mod_name == this_mod	-- Check if M appears in the set of modules 'below' M
					-- This seems like a convenient place to check
	   = WARN( not is_boot, ptext SLIT("Wierd:") <+> ppr this_mod <+> 
			        ptext SLIT("imports itself (perhaps indirectly)") )
	     so_far
 
265
	   | not opened 		-- We didn't even open the interface
266
	   =		-- This happens when a module, Foo, that we explicitly imported has 
267
268
269
			-- 'import Baz' in its interface file, recording that Baz is below
			-- Foo in the module dependency hierarchy.  We want to propagate this
			-- information.  The Nothing says that we didn't even open the interface
270
			-- file but we must still propagate the dependency info.
271
			-- The module in question must be a local module (in the same package)
272
273
	     go_for_it NothingAtAll

274

275
	   | is_lib_module && not has_orphans
276
	   = so_far		
277
	   
278
	   | is_lib_module 			-- Record the module version only
279
	   = go_for_it (Everything module_vers)
280

281
	   | otherwise
282
	   = go_for_it whats_imported
283
284
285

	     where
		go_for_it exports = (mod_name, has_orphans, is_boot, exports) : so_far
286
	        mod_iface 	  = lookupTableByModName hit pit mod_name `orElse` panic "mkImportInfo"
287
288
289
290
		mod		  = mi_module mod_iface
	        is_lib_module     = not (isModuleInThisPackage mod)
	        version_info      = mi_version mod_iface
	        version_env       = vers_decls version_info
291
		module_vers	  = vers_module version_info
292

293
294
		whats_imported = Specifically module_vers
					      export_vers import_items 
295
296
297
					      (vers_rules version_info)

	        import_items = [(n,v) | n <- lookupWithDefaultModuleEnv mv_map [] mod,
298
				        let v = lookupNameEnv version_env n `orElse` 
299
300
					        pprPanic "mk_whats_imported" (ppr n)
			       ]
301
302
303
304
	        export_vers | moduleName mod `elem` import_all_mods 
			    = Just (vers_exports version_info)
			    | otherwise
			    = Nothing
305
	
306
	import_info = foldFM mk_imp_info [] mod_map
sof's avatar
sof committed
307
    in
308
    traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map)))	`thenRn_`
309
    returnRn import_info
310

311

312
addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a]
313
addItem fm mod x = extendModuleEnv_C add_item fm mod [x]
314
315
		 where
		   add_item xs _ = x:xs
316
\end{code}
317

318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
%*********************************************************
%*						 	 *
\subsection{Slurping declarations}
%*							 *
%*********************************************************

\begin{code}
-------------------------------------------------------
slurpImpDecls source_fvs
  = traceRn (text "slurpImp" <+> fsep (map ppr (nameSetToList source_fvs))) `thenRn_`

	-- The current slurped-set records all local things
    getSlurped					`thenRn` \ source_binders ->
    slurpSourceRefs source_binders source_fvs	`thenRn` \ (decls, needed) ->

	-- Then get everything else
    closeDecls decls needed			`thenRn` \ decls1 ->

	-- Finally, get any deferred data type decls
    slurpDeferredDecls decls1			`thenRn` \ final_decls -> 

    returnRn final_decls


-------------------------------------------------------
slurpSourceRefs :: NameSet			-- Variables defined in source
		-> FreeVars			-- Variables referenced in source
		-> RnMG ([RenamedHsDecl],
			 FreeVars)		-- Un-satisfied needs
-- The declaration (and hence home module) of each gate has
-- already been loaded

slurpSourceRefs source_binders source_fvs
  = go_outer [] 			-- Accumulating decls
	     emptyFVs 			-- Unsatisfied needs
	     emptyFVs			-- Accumulating gates
  	     (nameSetToList source_fvs)	-- Things whose defn hasn't been loaded yet
  where
	-- The outer loop repeatedly slurps the decls for the current gates
	-- and the instance decls 

	-- The outer loop is needed because consider
	--	instance Foo a => Baz (Maybe a) where ...
	-- It may be that @Baz@ and @Maybe@ are used in the source module,
	-- but not @Foo@; so we need to chase @Foo@ too.
	--
	-- We also need to follow superclass refs.  In particular, 'chasing @Foo@' must
	-- include actually getting in Foo's class decl
	--	class Wib a => Foo a where ..
	-- so that its superclasses are discovered.  The point is that Wib is a gate too.
	-- We do this for tycons too, so that we look through type synonyms.

    go_outer decls fvs all_gates []	
	= returnRn (decls, fvs)

    go_outer decls fvs all_gates refs	-- refs are not necessarily slurped yet
	= traceRn (text "go_outer" <+> ppr refs)		`thenRn_`
	  foldlRn go_inner (decls, fvs, emptyFVs) refs		`thenRn` \ (decls1, fvs1, gates1) ->
	  getImportedInstDecls (all_gates `plusFV` gates1)	`thenRn` \ inst_decls ->
	  rnInstDecls decls1 fvs1 gates1 inst_decls		`thenRn` \ (decls2, fvs2, gates2) ->
	  go_outer decls2 fvs2 (all_gates `plusFV` gates2)
			       (nameSetToList (gates2 `minusNameSet` all_gates))
		-- Knock out the all_gates because even if we don't slurp any new
		-- decls we can get some apparently-new gates from wired-in names

    go_inner (decls, fvs, gates) wanted_name
	= importDecl wanted_name 		`thenRn` \ import_result ->
	  case import_result of
	    AlreadySlurped -> returnRn (decls, fvs, gates)
	    WiredIn        -> returnRn (decls, fvs, gates `plusFV` getWiredInGates wanted_name)
	    Deferred       -> returnRn (decls, fvs, gates `addOneFV` wanted_name)	-- It's a type constructor
			
	    HereItIs decl -> rnIfaceTyClDecl decl		`thenRn` \ (new_decl, fvs1) ->
			     returnRn (TyClD new_decl : decls, 
				       fvs1 `plusFV` fvs,
			   	       gates `plusFV` getGates source_fvs new_decl)

rnInstDecls decls fvs gates []
  = returnRn (decls, fvs, gates)
rnInstDecls decls fvs gates (d:ds) 
  = rnIfaceDecl d		`thenRn` \ (new_decl, fvs1) ->
    rnInstDecls (new_decl:decls) 
	        (fvs1 `plusFV` fvs)
		(gates `plusFV` getInstDeclGates new_decl)
		ds
\end{code}


\begin{code}
-------------------------------------------------------
-- closeDecls keeps going until the free-var set is empty
closeDecls decls needed
  | not (isEmptyFVs needed)
  = slurpDecls decls needed	`thenRn` \ (decls1, needed1) ->
    closeDecls decls1 needed1

  | otherwise
  = getImportedRules 			`thenRn` \ rule_decls ->
    case rule_decls of
	[]    -> returnRn decls	-- No new rules, so we are done
	other -> rnIfaceDecls decls emptyFVs rule_decls 	`thenRn` \ (decls1, needed1) ->
		 closeDecls decls1 needed1
		 

-------------------------------------------------------
-- Augment decls with any decls needed by needed.
-- Return also free vars of the new decls (only)
slurpDecls decls needed
  = go decls emptyFVs (nameSetToList needed) 
  where
    go decls fvs []         = returnRn (decls, fvs)
    go decls fvs (ref:refs) = slurpDecl decls fvs ref	`thenRn` \ (decls1, fvs1) ->
			      go decls1 fvs1 refs

-------------------------------------------------------
slurpDecl decls fvs wanted_name
  = importDecl wanted_name 		`thenRn` \ import_result ->
    case import_result of
	-- Found a declaration... rename it
	HereItIs decl -> rnIfaceTyClDecl decl		`thenRn` \ (new_decl, fvs1) ->
			 returnRn (TyClD new_decl:decls, fvs1 `plusFV` fvs)

	-- No declaration... (wired in thing, or deferred, or already slurped)
	other -> returnRn (decls, fvs)


-------------------------------------------------------
rnIfaceDecls :: [RenamedHsDecl] -> FreeVars
	     -> [(Module, RdrNameHsDecl)]
	     -> RnM d ([RenamedHsDecl], FreeVars)
rnIfaceDecls decls fvs []     = returnRn (decls, fvs)
rnIfaceDecls decls fvs (d:ds) = rnIfaceDecl d		`thenRn` \ (new_decl, fvs1) ->
				rnIfaceDecls (new_decl:decls) (fvs1 `plusFV` fvs) ds

rnIfaceDecl	(mod, decl) = initIfaceRnMS mod (rnDecl decl)	
rnIfaceTyClDecl (mod, decl) = initIfaceRnMS mod (rnTyClDecl decl)	
\end{code}


sof's avatar
sof committed
457
\begin{code}
458
getSlurped
sof's avatar
sof committed
459
  = getIfacesRn 	`thenRn` \ ifaces ->
460
    returnRn (iSlurp ifaces)
sof's avatar
sof committed
461

462
recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = imp_names })
463
	    avail
464
  = let
sof's avatar
sof committed
465
	new_slurped_names = addAvailToNameSet slurped_names avail
466
	new_imp_names     = availName avail : imp_names
467
468
    in
    ifaces { iSlurp  = new_slurped_names, iVSlurp = new_imp_names }
sof's avatar
sof committed
469

470
471
472
473
recordLocalSlurps local_avails
  = getIfacesRn 	`thenRn` \ ifaces ->
    let
	new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
sof's avatar
sof committed
474
    in
475
    setIfacesRn (ifaces { iSlurp  = new_slurped_names })
sof's avatar
sof committed
476
477
478
\end{code}


479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631

%*********************************************************
%*						 	 *
\subsection{Deferred declarations}
%*							 *
%*********************************************************

The idea of deferred declarations is this.  Suppose we have a function
	f :: T -> Int
	data T = T1 A | T2 B
	data A = A1 X | A2 Y
	data B = B1 P | B2 Q
Then we don't want to load T and all its constructors, and all
the types those constructors refer to, and all the types *those*
constructors refer to, and so on.  That might mean loading many more
interface files than is really necessary.  So we 'defer' loading T.

But f might be strict, and the calling convention for evaluating
values of type T depends on how many constructors T has, so 
we do need to load T, but not the full details of the type T.
So we load the full decl for T, but only skeleton decls for A and B:
	f :: T -> Int
	data T = {- 2 constructors -}

Whether all this is worth it is moot.

\begin{code}
slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
slurpDeferredDecls decls = returnRn decls

{-	OMIT FOR NOW
slurpDeferredDecls :: [RenamedHsDecl] -> RnMG [RenamedHsDecl]
slurpDeferredDecls decls
  = getDeferredDecls						`thenRn` \ def_decls ->
    rnIfaceDecls decls emptyFVs (map stripDecl def_decls)	`thenRn` \ (decls1, fvs) ->
    ASSERT( isEmptyFVs fvs )
    returnRn decls1

stripDecl (mod, TyClD (TyData dt _ tc tvs _ nconstrs _ loc name1 name2))
  = (mod, TyClD (TyData dt [] tc tvs [] nconstrs Nothing loc
		name1 name2))
	-- Nuke the context and constructors
	-- But retain the *number* of constructors!
	-- Also the tvs will have kinds on them.
-}
\end{code}


%*********************************************************
%*						 	 *
\subsection{Extracting the `gates'}
%*							 *
%*********************************************************

When we import a declaration like
\begin{verbatim}
	data T = T1 Wibble | T2 Wobble
\end{verbatim}
we don't want to treat @Wibble@ and @Wobble@ as gates
{\em unless} @T1@, @T2@ respectively are mentioned by the user program.
If only @T@ is mentioned
we want only @T@ to be a gate;
that way we don't suck in useless instance
decls for (say) @Eq Wibble@, when they can't possibly be useful.

@getGates@ takes a newly imported (and renamed) decl, and the free
vars of the source program, and extracts from the decl the gate names.

\begin{code}
getGates source_fvs (IfaceSig _ ty _ _)
  = extractHsTyNames ty

getGates source_fvs (ClassDecl ctxt cls tvs _ sigs _ _ _ )
  = (delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) sigs)
		        (hsTyVarNames tvs)
     `addOneToNameSet` cls)
    `plusFV` maybe_double
  where
    get (ClassOpSig n _ ty _) 
	| n `elemNameSet` source_fvs = extractHsTyNames ty
	| otherwise		     = emptyFVs

	-- If we load any numeric class that doesn't have
	-- Int as an instance, add Double to the gates. 
	-- This takes account of the fact that Double might be needed for
	-- defaulting, but we don't want to load Double (and all its baggage)
	-- if the more exotic classes aren't used at all.
    maybe_double | nameUnique cls `elem` fractionalClassKeys 
		 = unitFV (getName doubleTyCon)
		 | otherwise
		 = emptyFVs

getGates source_fvs (TySynonym tycon tvs ty _)
  = delListFromNameSet (extractHsTyNames ty)
		       (hsTyVarNames tvs)
	-- A type synonym type constructor isn't a "gate" for instance decls

getGates source_fvs (TyData _ ctxt tycon tvs cons _ _ _ _ _)
  = delListFromNameSet (foldr (plusFV . get) (extractHsCtxtTyNames ctxt) cons)
		       (hsTyVarNames tvs)
    `addOneToNameSet` tycon
  where
    get (ConDecl n _ tvs ctxt details _)
	| n `elemNameSet` source_fvs
		-- If the constructor is method, get fvs from all its fields
	= delListFromNameSet (get_details details `plusFV` 
		  	      extractHsCtxtTyNames ctxt)
			     (hsTyVarNames tvs)
    get (ConDecl n _ tvs ctxt (RecCon fields) _)
		-- Even if the constructor isn't mentioned, the fields
		-- might be, as selectors.  They can't mention existentially
		-- bound tyvars (typechecker checks for that) so no need for 
		-- the deleteListFromNameSet part
	= foldr (plusFV . get_field) emptyFVs fields
	
    get other_con = emptyFVs

    get_details (VanillaCon tys) = plusFVs (map get_bang tys)
    get_details (InfixCon t1 t2) = get_bang t1 `plusFV` get_bang t2
    get_details (RecCon fields)  = plusFVs [get_bang t | (_, t) <- fields]

    get_field (fs,t) | any (`elemNameSet` source_fvs) fs = get_bang t
		     | otherwise			 = emptyFVs

    get_bang bty = extractHsTyNames (getBangType bty)
\end{code}

@getWiredInGates@ is just like @getGates@, but it sees a wired-in @Name@
rather than a declaration.

\begin{code}
getWiredInGates :: Name -> FreeVars
getWiredInGates name 	-- No classes are wired in
  = case lookupNameEnv wiredInThingEnv name of
	Just (AnId the_id) -> getWiredInGates_s (namesOfType (idType the_id))

	Just (ATyCon tc)
	  |  isSynTyCon tc
	  -> getWiredInGates_s (delListFromNameSet (namesOfType ty) (map getName tyvars))
	  where
	     (tyvars,ty)  = getSynTyConDefn tc

	other -> unitFV name

getWiredInGates_s names = foldr (plusFV . getWiredInGates) emptyFVs (nameSetToList names)
\end{code}

\begin{code}
getInstDeclGates (InstD (InstDecl inst_ty _ _ _ _)) = extractHsTyNames inst_ty
getInstDeclGates other				    = emptyFVs
\end{code}


632
633
%*********************************************************
%*							*
634
\subsection{Getting in a declaration}
635
636
637
%*							*
%*********************************************************

638
639
\begin{code}
importDecl :: Name -> RnMG ImportDeclResult
640

641
642
643
644
data ImportDeclResult
  = AlreadySlurped
  | WiredIn	
  | Deferred
645
  | HereItIs (Module, RdrNameTyClDecl)
646

647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
importDecl name
  = 	-- Check if it was loaded before beginning this module
    checkAlreadyAvailable name		`thenRn` \ done ->
    if done then
	returnRn AlreadySlurped
    else

	-- Check if we slurped it in while compiling this module
    getIfacesRn				`thenRn` \ ifaces ->
    if name `elemNameSet` iSlurp ifaces then	
	returnRn AlreadySlurped	
    else 

	-- Don't slurp in decls from this module's own interface file
	-- (Indeed, this shouldn't happen.)
    if isLocallyDefined name then
	addWarnRn (importDeclWarn name) `thenRn_`
	returnRn AlreadySlurped
    else

	-- When we find a wired-in name we must load its home
	-- module so that we find any instance decls lurking therein
    if name `elemNameEnv` wiredInThingEnv then
	loadHomeInterface doc name	`thenRn_`
	returnRn WiredIn
672

673
    else getNonWiredInDecl name
674
  where
675
    doc = ptext SLIT("need home module for wired in thing") <+> ppr name
676

677
678
679
680
681
getNonWiredInDecl :: Name -> RnMG ImportDeclResult
getNonWiredInDecl needed_name 
  = traceRn doc_str				`thenRn_`
    loadHomeInterface doc_str needed_name	`thenRn` \ ifaces ->
    case lookupNameEnv (iDecls ifaces) needed_name of
682

683
684
685
{- 		OMIT DEFERRED STUFF FOR NOW, TILL GHCI WORKS
      Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _ _)))
	-- This case deals with deferred import of algebraic data types
686

687
688
689
690
691
692
693
694
695
696
697
	|  not opt_NoPruneTyDecls

	&& (opt_IgnoreIfacePragmas || ncons > 1)
		-- We only defer if imported interface pragmas are ingored
		-- or if it's not a product type.
		-- Sole reason: The wrapper for a strict function may need to look
		-- inside its arg, and hence need to see its arg type's constructors.

	&& not (getUnique tycon_name `elem` cCallishTyKeys)
		-- Never defer ccall types; we have to unbox them, 
		-- and importing them does no harm
698

699

700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
	->  	-- OK, so we're importing a deferrable data type
	    if needed_name == tycon_name
	 	-- The needed_name is the TyCon of a data type decl
		-- Record that it's slurped, put it in the deferred set
		-- and don't return a declaration at all
		setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces 
							      `addOneToNameSet` tycon_name})
				    	 version (AvailTC needed_name [needed_name]))	`thenRn_`
		returnRn Deferred

	    else
	  	-- The needed name is a constructor of a data type decl,
		-- getting a constructor, so remove the TyCon from the deferred set
		-- (if it's there) and return the full declaration
		setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces 
							       `delFromNameSet` tycon_name})
				    version avail)	`thenRn_`
		returnRn (HereItIs decl)
	where
	   tycon_name = availName avail
-}

      Just (avail,_,decl)
	-> setIfacesRn (recordSlurp ifaces avail)	`thenRn_`
	   returnRn (HereItIs decl)

      Nothing 
	-> addErrRn (getDeclErr needed_name)	`thenRn_` 
	   returnRn AlreadySlurped
  where
     doc_str = ptext SLIT("need decl for") <+> ppr needed_name

{-		OMIT FOR NOW
getDeferredDecls :: RnMG [(Module, RdrNameHsDecl)]
getDeferredDecls 
  = getIfacesRn		`thenRn` \ ifaces ->
    let
	decls_map   	    = iDecls ifaces
	deferred_names	    = nameSetToList (iDeferred ifaces)
        get_abstract_decl n = case lookupNameEnv decls_map n of
				 Just (_, _, _, decl) -> decl
    in
    traceRn (sep [text "getDeferredDecls", nest 4 (fsep (map ppr deferred_names))])	`thenRn_`
    returnRn (map get_abstract_decl deferred_names)
-}
745
\end{code}
746

747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
@getWiredInDecl@ maps a wired-in @Name@ to what it makes available.
It behaves exactly as if the wired in decl were actually in an interface file.
Specifically,
\begin{itemize}
\item	if the wired-in name is a data type constructor or a data constructor, 
	it brings in the type constructor and all the data constructors; and
	marks as ``occurrences'' any free vars of the data con.

\item 	similarly for synonum type constructor

\item 	if the wired-in name is another wired-in Id, it marks as ``occurrences''
	the free vars of the Id's type.

\item	it loads the interface file for the wired-in thing for the
	sole purpose of making sure that its instance declarations are available
\end{itemize}
All this is necessary so that we know all types that are ``in play'', so
that we know just what instances to bring into scope.
	

%********************************************************
768
%*							*
769
\subsection{Checking usage information}
770
%*							*
771
%********************************************************
772

773
774
775
776
777
@recompileRequired@ is called from the HscMain.   It checks whether
a recompilation is required.  It needs access to the persistent state,
finder, etc, because it may have to load lots of interface files to
check their versions.

778
\begin{code}
779
780
781
782
type RecompileRequired = Bool
upToDate  = False	-- Recompile not required
outOfDate = True	-- Recompile required

783
recompileRequired :: Module 
784
785
		  -> Bool 		-- Source unchanged
		  -> Maybe ModIface 	-- Old interface, if any
786
787
788
		  -> RnMG RecompileRequired
recompileRequired mod source_unchanged maybe_iface
  = traceRn (text "Considering whether compilation is required for" <+> ppr mod <> colon)	`thenRn_`
789
790
791
792
793
794

	-- CHECK WHETHER THE SOURCE HAS CHANGED
    if not source_unchanged then
	traceRn (nest 4 (text "Source file changed or recompilation check turned off"))	`thenRn_` 
	returnRn outOfDate
    else
795

796
797
798
799
800
801
	-- CHECK WHETHER WE HAVE AN OLD IFACE
    case maybe_iface of 
	Nothing -> traceRn (nest 4 (ptext SLIT("No old interface file")))	`thenRn_`
		   returnRn outOfDate ;

	Just iface  ->    	-- Source code unchanged and no errors yet... carry on 
802
			checkList [checkModUsage u | u <- mi_usages iface]
803
804
805
806
807
808
809
810

checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
checkList []		 = returnRn upToDate
checkList (check:checks) = check	`thenRn` \ recompile ->
			   if recompile then 
				returnRn outOfDate
			   else
				checkList checks
811
\end{code}
812
813
	
\begin{code}
814
checkModUsage :: ImportVersion Name -> RnMG RecompileRequired
815
816
817
818
-- Given the usage information extracted from the old
-- M.hi file for the module being compiled, figure out
-- whether M needs to be recompiled.

819
checkModUsage (mod_name, _, _, NothingAtAll)
820
821
822
823
824
825
826
	-- If CurrentModule.hi contains 
	--	import Foo :: ;
	-- then that simply records that Foo lies below CurrentModule in the
	-- hierarchy, but CurrentModule doesn't depend in any way on Foo.
	-- In this case we don't even want to open Foo's interface.
  = up_to_date (ptext SLIT("Nothing used from:") <+> ppr mod_name)

827
checkModUsage (mod_name, _, _, whats_imported)
828
829
830
831
832
833
834
835
836
  = tryLoadInterface doc_str mod_name ImportBySystem	`thenRn` \ (ifaces, maybe_err) ->
    case maybe_err of {
	Just err -> out_of_date (sep [ptext SLIT("Can't find version number for module"), 
				      ppr mod_name]) ;
		-- Couldn't find or parse a module mentioned in the
		-- old interface file.  Don't complain -- it might just be that
		-- the current module doesn't need that import and it's been deleted

	Nothing -> 
837
838

    getHomeIfaceTableRn					`thenRn` \ hit ->
839
840
841
842
843
844
845
    let
	mod_details   = lookupTableByModName hit (iPIT ifaces) mod_name
			`orElse` panic "checkModUsage"
	new_vers      = mi_version mod_details
	new_decl_vers = vers_decls new_vers
    in
    case whats_imported of {	-- NothingAtAll dealt with earlier
846

847
848
849
850
851
      Everything old_mod_vers -> checkModuleVersion old_mod_vers new_vers	`thenRn` \ recompile ->
				 if recompile then
					out_of_date (ptext SLIT("...and I needed the whole module"))
				 else
					returnRn upToDate ;
852

853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
      Specifically old_mod_vers maybe_old_export_vers old_decl_vers old_rule_vers ->

	-- CHECK MODULE
    checkModuleVersion old_mod_vers new_vers	`thenRn` \ recompile ->
    if not recompile then
	returnRn upToDate
    else
				 
	-- CHECK EXPORT LIST
    if checkExportList maybe_old_export_vers new_vers then
	out_of_date (ptext SLIT("Export list changed"))
    else

	-- CHECK RULES
    if old_rule_vers /= vers_rules new_vers then
	out_of_date (ptext SLIT("Rules changed"))
    else

	-- CHECK ITEMS ONE BY ONE
    checkList [checkEntityUsage new_decl_vers u | u <- old_decl_vers]	`thenRn` \ recompile ->
    if recompile then
	returnRn outOfDate	-- This one failed, so just bail out now
    else
	up_to_date (ptext SLIT("...but the bits I use haven't."))

    }}
879
  where
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
    doc_str = sep [ptext SLIT("need version info for"), ppr mod_name]

------------------------
checkModuleVersion old_mod_vers new_vers
  | vers_module new_vers == old_mod_vers
  = up_to_date (ptext SLIT("Module version unchanged"))

  | otherwise
  = out_of_date (ptext SLIT("Module version has changed"))

------------------------
checkExportList Nothing  new_vers = upToDate
checkExportList (Just v) new_vers = v /= vers_exports new_vers

------------------------
checkEntityUsage new_vers (name,old_vers)
  = case lookupNameEnv new_vers name of

	Nothing       -> 	-- We used it before, but it ain't there now
			  out_of_date (sep [ptext SLIT("No longer exported:"), ppr name])

	Just new_vers 	-- It's there, but is it up to date?
	  | new_vers == old_vers -> returnRn upToDate
	  | otherwise	 	 -> out_of_date (sep [ptext SLIT("Out of date:"), ppr name])

up_to_date  msg = traceRn msg `thenRn_` returnRn upToDate
out_of_date msg = traceRn msg `thenRn_` returnRn outOfDate
907
\end{code}
908

909

910
%*********************************************************
sof's avatar
sof committed
911
%*						 	 *
912
\subsection{Errors}
sof's avatar
sof committed
913
%*							 *
914
%*********************************************************
915

916
\begin{code}
917
getDeclErr name
918
919
920
  = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
	  ptext SLIT("from module") <+> quotes (ppr (nameModule name))
	 ]
921

922
importDeclWarn name
923
924
925
926
  = sep [ptext SLIT(
    "Compiler tried to import decl from interface file with same name as module."), 
	 ptext SLIT(
    "(possible cause: module name clashes with interface file already in scope.)")
sof's avatar
sof committed
927
	] $$
928
    hsep [ptext SLIT("name:"), quotes (ppr name)]
929
\end{code}