RnIfaces.lhs 22.3 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
8
module RnIfaces
       (
9
	getInterfaceExports,
10
	getImportedInstDecls, getImportedRules,
11
	lookupFixityRn, 
12
	importDecl, ImportDeclResult(..), recordLocalSlurps, 
13
	mkImportInfo, getSlurped
14
15
       )
where
16

17
#include "HsVersions.h"
18

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

46
import List		( nub )
47
48
\end{code}

49

50
51
%*********************************************************
%*							*
sof's avatar
sof committed
52
\subsection{Getting what a module exports}
53
54
%*							*
%*********************************************************
55

56
@getInterfaceExports@ is called only for directly-imported modules.
57

58
\begin{code}
59
60
getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, Avails)
getInterfaceExports mod_name from
61
62
63
64
65
66
67
68
69
70
71
  = 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)
72
73
    }
    where
74
      doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")]
sof's avatar
sof committed
75
76
77
78
79
\end{code}


%*********************************************************
%*							*
80
\subsection{Instance declarations are handled specially}
sof's avatar
sof committed
81
82
83
84
%*							*
%*********************************************************

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

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

105
    traceRn (sep [text "getImportedInstDecls:", 
106
		  nest 4 (fsep (map ppr gate_list)),
107
108
		  text "Slurped" <+> int (length decls) <+> text "instance declarations",
		  nest 4 (vcat (map ppr_brief_inst_decl decls))])	`thenRn_`
109
110
    returnRn decls
  where
111
112
    gate_list      = nameSetToList gates

113
114
115
116
117
ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
  = case inst_ty of
	HsForAllTy _ _ tau -> ppr tau
	other		   -> ppr inst_ty

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

136
selectGated gates decl_bag
137
	-- Select only those decls whose gates are *all* in 'gates'
138
139
140
#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
141

142
143
144
  | otherwise
#endif
  = foldrBag select ([], emptyBag) decl_bag
145
  where
146
147
148
149
    select (reqd, decl) (yes, no)
	| isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
	| otherwise				     = (yes,      (reqd,decl) `consBag` no)

150
151
lookupFixityRn :: Name -> RnMS Fixity
lookupFixityRn name
152
153
  | isLocallyDefined name
  = getFixityEnv			`thenRn` \ local_fix_env ->
154
    returnRn (lookupLocalFixity local_fix_env name)
155
156

  | otherwise	-- Imported
157
158
159
160
161
162
163
      -- For imported names, we have to get their fixities by doing a loadHomeInterface,
      -- and consulting the Ifaces that comes back from that, because the interface
      -- file for the Name might not have been loaded yet.  Why not?  Suppose you import module A,
      -- which exports a function 'f', which is defined in module B.  Then B isn't loaded
      -- right away (after all, it's possible that nothing from B will be used).
      -- When we come across a use of 'f', we need to know its fixity, and it's then,
      -- and only then, that we load B.hi.  That is what's happening here.
164
  = getHomeIfaceTableRn 		`thenRn` \ hit ->
165
    loadHomeInterface doc name		`thenRn` \ ifaces ->
166
167
168
    case lookupTable hit (iPIT ifaces) name of
	Just iface -> returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity)
	Nothing	   -> returnRn defaultFixity
169
  where
170
    doc = ptext SLIT("Checking fixity for") <+> ppr name
171
172
\end{code}

sof's avatar
sof committed
173
174
175
176
177
178
179

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

180
181
182
183
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:

184
\begin{itemize}
185
186
187
\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
188
\end{itemize}
189
190

Why (b)?  Because if @Foo@ changes then this module's export list
191
192
193
194
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.

195
Why (c)?  Consider this:
196
197
198
199
200
\begin{verbatim}
	module A( f, g ) where	|	module B( f ) where
	  import B( f )		|	  f = h 3
	  g = ...		|	  h = ...
\end{verbatim}
201

202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
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> :: ... ;
226
227
228
229
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.
230

231
\begin{code}
232
233
234
235
236
mkImportInfo :: ModuleName			-- Name of this module
	     -> [ImportDecl n]			-- The import decls
	     -> RnMG [ImportVersion Name]

mkImportInfo this_mod imports
237
  = getIfacesRn					`thenRn` \ ifaces ->
238
    getHomeIfaceTableRn				`thenRn` \ hit -> 
239
    let
240
241
242
	import_all_mods :: [ModuleName]
		-- Modules where we imported all the names
		-- (apart from hiding some, perhaps)
243
244
	import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports,
				    import_all imp_list ]
245
246
247

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

249
250
	mod_map   = iImpModInfo ifaces
	imp_names = iVSlurp     ifaces
251
	pit	  = iPIT 	ifaces
252

253
	-- mv_map groups together all the things imported from a particular module.
254
	mv_map :: ModuleEnv [Name]
255
	mv_map = foldr add_mv emptyModuleEnv imp_names
256

257
        add_mv name mv_map = addItem mv_map (nameModule name) name
258

259
	-- Build the result list by adding info for each module.
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
	-- 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.

275
	mk_imp_info mod_name (has_orphans, is_boot, opened) so_far
276
277
278
279
280
281
	   | 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
 
282
	   | not opened 		-- We didn't even open the interface
283
	   =		-- This happens when a module, Foo, that we explicitly imported has 
284
285
286
			-- '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
287
			-- file but we must still propagate the dependency info.
288
			-- The module in question must be a local module (in the same package)
289
290
	     go_for_it NothingAtAll

291

292
	   | is_lib_module && not has_orphans
293
	   = so_far		
294
	   
295
	   | is_lib_module 			-- Record the module version only
296
	   = go_for_it (Everything module_vers)
297

298
	   | otherwise
299
	   = go_for_it whats_imported
300
301
302
303
304
305
306
307

	     where
		go_for_it exports = (mod_name, has_orphans, is_boot, exports) : so_far
	        mod_iface 	  = lookupIface hit pit mod_name
		mod		  = mi_module mod_iface
	        is_lib_module     = not (isModuleInThisPackage mod)
	        version_info      = mi_version mod_iface
	        version_env       = vers_decls version_info
308
		module_vers	  = vers_module version_info
309

310
311
		whats_imported = Specifically module_vers
					      export_vers import_items 
312
313
314
					      (vers_rules version_info)

	        import_items = [(n,v) | n <- lookupWithDefaultModuleEnv mv_map [] mod,
315
				        let v = lookupNameEnv version_env n `orElse` 
316
317
					        pprPanic "mk_whats_imported" (ppr n)
			       ]
318
319
320
321
	        export_vers | moduleName mod `elem` import_all_mods 
			    = Just (vers_exports version_info)
			    | otherwise
			    = Nothing
322
	
323
	import_info = foldFM mk_imp_info [] mod_map
sof's avatar
sof committed
324
    in
325
    traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map)))	`thenRn_`
326
    returnRn import_info
327

328

329
addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a]
330
addItem fm mod x = extendModuleEnv_C add_item fm mod [x]
331
332
		 where
		   add_item xs _ = x:xs
333
\end{code}
334

sof's avatar
sof committed
335
\begin{code}
336
getSlurped
sof's avatar
sof committed
337
  = getIfacesRn 	`thenRn` \ ifaces ->
338
    returnRn (iSlurp ifaces)
sof's avatar
sof committed
339

340
recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = imp_names })
341
	    avail
342
  = let
sof's avatar
sof committed
343
	new_slurped_names = addAvailToNameSet slurped_names avail
344
	new_imp_names     = availName avail : imp_names
345
346
    in
    ifaces { iSlurp  = new_slurped_names, iVSlurp = new_imp_names }
sof's avatar
sof committed
347

348
349
350
351
recordLocalSlurps local_avails
  = getIfacesRn 	`thenRn` \ ifaces ->
    let
	new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
sof's avatar
sof committed
352
    in
353
    setIfacesRn (ifaces { iSlurp  = new_slurped_names })
sof's avatar
sof committed
354
355
356
\end{code}


357
358
%*********************************************************
%*							*
359
\subsection{Getting in a declaration}
360
361
362
%*							*
%*********************************************************

363
364
\begin{code}
importDecl :: Name -> RnMG ImportDeclResult
365

366
367
368
369
370
data ImportDeclResult
  = AlreadySlurped
  | WiredIn	
  | Deferred
  | HereItIs (Module, RdrNameHsDecl)
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
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
397

398
    else getNonWiredInDecl name
399
  where
400
    doc = ptext SLIT("need home module for wired in thing") <+> ppr name
401

402
403
404
405
406
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
407

408
409
410
{- 		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
411

412
413
414
415
416
417
418
419
420
421
422
	|  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
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
457
458
459
460
461
462
463
464
465
466
467
468
469
	->  	-- 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)
-}
470
\end{code}
471

472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
@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.
	

%********************************************************
493
%*							*
494
\subsection{Checking usage information}
495
%*							*
496
%********************************************************
497

498
\begin{code}
499
500
501
502
503
504
505
506
507
508
509
510
511
type RecompileRequired = Bool
upToDate  = False	-- Recompile not required
outOfDate = True	-- Recompile required

recompileRequired :: Module -> Bool -> Maybe ModIface -> RnMG RecompileRequired
recompileRequired mod source_unchanged maybe_iface
  = traceRn (text "Considering whether compilation is required for" <+> ppr mod <> colon)	`thenRn_`

	-- 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
512

513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
	-- 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 
			getHomeIfaceTableRn					`thenRn` \ hit ->
			checkList [checkModUsage hit u | u <- mi_usages iface]

checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
checkList []		 = returnRn upToDate
checkList (check:checks) = check	`thenRn` \ recompile ->
			   if recompile then 
				returnRn outOfDate
			   else
				checkList checks
529
\end{code}
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
	
\begin{code}
checkModUsage :: HomeIfaceTable -> ImportVersion Name -> RnMG RecompileRequired
-- Given the usage information extracted from the old
-- M.hi file for the module being compiled, figure out
-- whether M needs to be recompiled.

checkModUsage hit (mod_name, _, _, NothingAtAll)
	-- 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)

checkModUsage hit (mod_name, _, _, whats_imported)
  = 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 -> 
    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
562

563
564
565
566
567
      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 ;
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
      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."))

    }}
595
  where
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
    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
623
\end{code}
624

625

626
%*********************************************************
sof's avatar
sof committed
627
%*						 	 *
628
\subsection{Errors}
sof's avatar
sof committed
629
%*							 *
630
%*********************************************************
631

632
\begin{code}
633
getDeclErr name
634
635
636
  = vcat [ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name),
	  ptext SLIT("from module") <+> quotes (ppr (nameModule name))
	 ]
637

638
importDeclWarn name
639
640
641
642
  = 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
643
	] $$
644
    hsep [ptext SLIT("name:"), quotes (ppr name)]
645
\end{code}