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

\begin{code}
module RnIfaces (
8
9
10
	getInterfaceExports, 
	getImportedInstDecls, getImportedRules,
	lookupFixity, loadHomeInterface,
11
	importDecl, recordSlurp,
12
	getImportVersions, getSlurped,
13

14
	checkUpToDate,
15

16
17
	getDeclBinders, getDeclSysBinders,
	removeContext	 	-- removeContext probably belongs somewhere else
18
19
    ) where

20
#include "HsVersions.h"
21

22
import CmdLineOpts	( opt_NoPruneDecls, opt_IgnoreIfacePragmas )
23
import HsSyn		( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), 
24
			  HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
sof's avatar
sof committed
25
			  ForeignDecl(..), ForKind(..), isDynamic,
26
27
			  FixitySig(..), RuleDecl(..),
			  isClassOpSig
28
			)
29
30
31
import BasicTypes	( Version, NewOrData(..), defaultFixity )
import RdrHsSyn		( RdrNameHsDecl, RdrNameInstDecl, RdrNameTyClDecl, RdrNameRuleDecl,
			  extractHsTyRdrNames
32
			)
33
import RnEnv		( mkImportedGlobalName, newImportedBinder, mkImportedGlobalFromRdrName,
sof's avatar
sof committed
34
			  lookupOccRn, lookupImplicitOccRn,
35
36
37
			  pprAvail,
			  availName, availNames, addAvailToNameSet,
			  FreeVars, emptyFVs
38
			)
39
import RnMonad
40
41
import RnHsSyn          ( RenamedHsDecl )
import ParseIface	( parseIface, IfaceStuff(..) )
42

43
import FiniteMap	( FiniteMap, sizeFM, emptyFM, delFromFM,
sof's avatar
sof committed
44
			  lookupFM, addToFM, addToFM_C, addListToFM, 
45
			  fmToList, elemFM, foldFM
sof's avatar
sof committed
46
			)
47
import Name		( Name {-instance NamedThing-},
sof's avatar
sof committed
48
			  nameModule, isLocallyDefined,
49
			  isWiredInName, nameUnique, NamedThing(..)
50
			 )
51
52
53
54
import Module		( Module, moduleString, pprModule,
			  mkVanillaModule, pprModuleName,
			  moduleUserString, moduleName, isLibModule,
			  ModuleName, WhereFrom(..),
55
56
			)
import RdrName		( RdrName, rdrNameOcc )
57
58
import NameSet
import Var		( Id )
59
import SrcLoc		( mkSrcLoc, SrcLoc )
60
import PrelMods		( pREL_GHC )
61
import PrelInfo		( cCallishTyKeys, thinAirModules )
62
import Bag
63
import Maybes		( MaybeErr(..), maybeToBool, orElse )
64
import ListSetOps	( unionLists )
65
import Outputable
sof's avatar
sof committed
66
import Unique		( Unique )
67
import StringBuffer     ( StringBuffer, hGetStringBuffer )
68
import FastString	( mkFastString )
69
import Lex
sof's avatar
sof committed
70
import Outputable
71
72
73

import IO	( isDoesNotExistError )
import List	( nub )
74
75
\end{code}

76

77
78
79
80
81
%*********************************************************
%*							*
\subsection{Loading a new interface file}
%*							*
%*********************************************************
82

83
\begin{code}
84
loadHomeInterface :: SDoc -> Name -> RnM d Ifaces
85
loadHomeInterface doc_str name
86
87
88
89
90
91
92
93
94
95
96
  = loadInterface doc_str (moduleName (nameModule name)) ImportBySystem		`thenRn` \ (_, ifaces) ->
    returnRn ifaces

loadOrphanModules :: [ModuleName] -> RnM d ()
loadOrphanModules mods
  | null mods = returnRn ()
  | otherwise = traceRn (text "Loading orphan modules:" <+> fsep (map pprModuleName mods))	`thenRn_` 
		mapRn_ load mods	`thenRn_`
		returnRn ()
  where
    load mod = loadInterface (pprModuleName mod <+> ptext SLIT("is a orphan-instance module")) mod ImportBySystem
97

98
99
100
loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (Module, Ifaces)
loadInterface doc_str mod_name from
 = getIfacesRn 			`thenRn` \ ifaces ->
sof's avatar
sof committed
101
   let
102
103
104
	mod_map  = iImpModInfo ifaces
	mod_info = lookupFM mod_map mod_name
	in_map   = maybeToBool mod_info
sof's avatar
sof committed
105
   in
106
107
108
109
110
111
112
113

	-- Issue a warning for a redundant {- SOURCE -} import
	-- It's redundant if the moduld is in the iImpModInfo at all,
	-- because we arrange to read all the ordinary imports before 
	-- any of the {- SOURCE -} imports
   warnCheckRn	(not (in_map && case from of {ImportByUserSource -> True; other -> False}))
		(warnRedundantSourceImport mod_name)	`thenRn_`

114
	-- CHECK WHETHER WE HAVE IT ALREADY
115
116
117
118
119
120
   case mod_info of {
	Just (_, _, Just (load_mod, _, _))
		-> 	-- We're read it already so don't re-read it
		    returnRn (load_mod, ifaces) ;

	mod_map_result ->
121
122

	-- READ THE MODULE IN
123
124
   findAndReadIface doc_str mod_name from in_map
   `thenRn` \ (hi_boot_read, read_result) ->
sof's avatar
sof committed
125
   case read_result of {
126
	Nothing -> 	-- Not found, so add an empty export env to the Ifaces map
127
			-- so that we don't look again
128
129
130
131
132
133
134
	   let
		mod         = mkVanillaModule mod_name
		new_mod_map = addToFM mod_map mod_name (0, False, Just (mod, False, []))
		new_ifaces  = ifaces { iImpModInfo = new_mod_map }
	   in
	   setIfacesRn new_ifaces		`thenRn_`
	   failWithRn (mod, new_ifaces) (noIfaceErr mod hi_boot_read) ;
135
136

	-- Found and parsed!
137
	Just (mod, iface) ->
138
139

	-- LOAD IT INTO Ifaces
140

sof's avatar
sof committed
141
142
143
144
	-- NB: *first* we do loadDecl, so that the provenance of all the locally-defined
	---    names is done correctly (notably, whether this is an .hi file or .hi-boot file).
	--     If we do loadExport first the wrong info gets into the cache (unless we
	-- 	explicitly tag each export which seems a bit of a bore)
145

146
    getModuleRn 		`thenRn` \ this_mod_nm ->
147
    let
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
	rd_decls = pi_decls iface
    in
    foldlRn (loadDecl mod)	     (iDecls ifaces) rd_decls 		`thenRn` \ new_decls ->
    foldlRn (loadInstDecl mod)	     (iInsts ifaces) (pi_insts iface)	`thenRn` \ new_insts ->
    foldlRn (loadRule mod)	     (iRules ifaces) (pi_rules iface)	`thenRn` \ new_rules -> 
    foldlRn (loadFixDecl mod_name)   (iFixes ifaces) rd_decls  		`thenRn` \ new_fixities ->
    mapRn   (loadExport this_mod_nm) (pi_exports iface)			`thenRn` \ avails_s ->
    let
	-- For an explicit user import, add to mod_map info about
	-- the things the imported module depends on, extracted
	-- from its usage info.
	mod_map1 = case from of
			ImportByUser -> addModDeps mod mod_map (pi_usages iface)
			other        -> mod_map

	-- Now add info about this module
	mod_map2    = addToFM mod_map1 mod_name mod_details
	mod_details = (pi_mod iface, pi_orphan iface, Just (mod, hi_boot_read, concat avails_s))

	new_ifaces = ifaces { iImpModInfo = mod_map2,
			      iDecls      = new_decls,
			      iFixes      = new_fixities,
			      iRules	  = new_rules,
			      iInsts      = new_insts }
172
    in
173
    setIfacesRn new_ifaces		`thenRn_`
174
    returnRn (mod, new_ifaces)
sof's avatar
sof committed
175
176
    }}

177
178
179
180
181
182
183
184
addModDeps :: Module -> ImportedModuleInfo
	   -> [ImportVersion a] -> ImportedModuleInfo
addModDeps mod mod_deps new_deps
  = foldr add mod_deps new_deps
  where
    is_lib = isLibModule mod	-- Don't record dependencies when importing a library module
    add (imp_mod, version, has_orphans, _) deps
	| is_lib && not has_orphans = deps
185
	| otherwise  =  addToFM_C combine deps imp_mod (version, has_orphans, Nothing)
186
187
188
189
190
191
192
193
194
	-- Record dependencies for modules that are
	--	either are dependent via a non-library module
	--	or contain orphan rules or instance decls

	-- Don't ditch a module that's already loaded!!
    combine old@(_, _, Just _)  new = old
    combine old@(_, _, Nothing) new = new

loadExport :: ModuleName -> ExportItem -> RnM d [AvailInfo]
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
loadExport this_mod (mod, entities)
  | mod == this_mod = returnRn []
	-- If the module exports anything defined in this module, just ignore it.
	-- Reason: otherwise it looks as if there are two local definition sites
	-- for the thing, and an error gets reported.  Easiest thing is just to
	-- filter them out up front. This situation only arises if a module
	-- imports itself, or another module that imported it.  (Necessarily,
	-- this invoves a loop.)  Consequence: if you say
	--	module A where
	--	   import B( AType )
	--	   type AType = ...
	--
	--	module B( AType ) where
	--	   import {-# SOURCE #-} A( AType )
	--
	-- then you'll get a 'B does not export AType' message.  A bit bogus
	-- but it's a bogus thing to do!

  | otherwise
214
  = mapRn (load_entity mod) entities
215
  where
216
    new_name mod occ = mkImportedGlobalName mod occ
217

sof's avatar
sof committed
218
219
    load_entity mod (Avail occ)
      =	new_name mod occ	`thenRn` \ name ->
sof's avatar
sof committed
220
	returnRn (Avail name)
sof's avatar
sof committed
221
222
223
    load_entity mod (AvailTC occ occs)
      =	new_name mod occ	      `thenRn` \ name ->
        mapRn (new_name mod) occs     `thenRn` \ names ->
sof's avatar
sof committed
224
        returnRn (AvailTC name names)
225

226

227
loadFixDecl :: ModuleName -> FixityEnv
228
	    -> (Version, RdrNameHsDecl)
229
230
	    -> RnM d FixityEnv
loadFixDecl mod_name fixity_env (version, FixD sig@(FixitySig rdr_name fixity loc))
231
232
233
  = 	-- Ignore the version; when the fixity changes the version of
	-- its 'host' entity changes, so we don't need a separate version
	-- number for fixities
234
    mkImportedGlobalName mod_name (rdrNameOcc rdr_name) 	`thenRn` \ name ->
235
236
237
238
239
240
    let
	new_fixity_env = addToNameEnv fixity_env name (FixitySig name fixity loc)
    in
    returnRn new_fixity_env

	-- Ignore the other sorts of decl
241
loadFixDecl mod_name fixity_env other_decl = returnRn fixity_env
242

243
244
loadDecl :: Module 
	 -> DeclsMap
245
	 -> (Version, RdrNameHsDecl)
246
	 -> RnM d DeclsMap
247

248
loadDecl mod decls_map (version, decl)
249
250
251
252
253
  = getDeclBinders new_name decl	`thenRn` \ maybe_avail ->
    case maybe_avail of {
	Nothing -> returnRn decls_map;	-- No bindings
	Just avail ->

254
255
256
257
    getDeclSysBinders new_name decl	`thenRn` \ sys_bndrs ->
    let
	main_name     = availName avail
	new_decls_map = foldl add_decl decls_map
258
				       [ (name, (version, avail, name==main_name, (mod, decl'))) 
259
260
				       | name <- sys_bndrs ++ availNames avail]
	add_decl decls_map (name, stuff)
261
	  = WARN( name `elemNameEnv` decls_map, ppr name )
262
263
264
	    addToNameEnv decls_map name stuff
    in
    returnRn new_decls_map
265
    }
266
  where
267
268
269
270
271
	-- newImportedBinder puts into the cache the binder with the
	-- module information set correctly.  When the decl is later renamed,
	-- the binding site will thereby get the correct module.
    new_name rdr_name loc = newImportedBinder mod rdr_name

sof's avatar
sof committed
272
    {-
273
274
      If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
      we toss away unfolding information.
sof's avatar
sof committed
275
276
277
278
279

      Also, if the signature is loaded from a module we're importing from source,
      we do the same. This is to avoid situations when compiling a pair of mutually
      recursive modules, peering at unfolding info in the interface file of the other, 
      e.g., you compile A, it looks at B's interface file and may as a result change
280
281
      its interface file. Hence, B is recompiled, maybe changing its interface file,
      which will the unfolding info used in A to become invalid. Simple way out is to
sof's avatar
sof committed
282
      just ignore unfolding info.
283
284
285
286

      [Jan 99: I junked the second test above.  If we're importing from an hi-boot
       file there isn't going to *be* any pragma info.  Maybe the above comment
       dates from a time where we picked up a .hi file first if it existed?]
sof's avatar
sof committed
287
    -}
288
    decl' = case decl of
289
290
291
	       SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas
			 ->  SigD (IfaceSig name tp [] loc)
	       other	 -> decl
sof's avatar
sof committed
292

293
294
loadInstDecl :: Module
	     -> Bag GatedDecl
295
	     -> RdrNameInstDecl
296
297
	     -> RnM d (Bag GatedDecl)
loadInstDecl mod insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
298
299
300
301
302
303
304
305
  = 
	-- Find out what type constructors and classes are "gates" for the
	-- instance declaration.  If all these "gates" are slurped in then
	-- we should slurp the instance decl too.
	-- 
	-- We *don't* want to count names in the context part as gates, though.
	-- For example:
	--		instance Foo a => Baz (T a) where ...
306
	--
307
308
	-- Here the gates are Baz and T, but *not* Foo.
    let 
309
310
	munged_inst_ty = removeContext inst_ty
	free_names     = extractHsTyRdrNames munged_inst_ty
311
    in
312
313
314
315
    setModuleRn (moduleName mod) $
    mapRn mkImportedGlobalFromRdrName free_names	`thenRn` \ gate_names ->
    returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)

316
317
318
319
320
321
322
323
324
325
326
327

-- In interface files, the instance decls now look like
--	forall a. Foo a -> Baz (T a)
-- so we have to strip off function argument types as well
-- as the bit before the '=>' (which is always empty in interface files)
removeContext (HsForAllTy tvs cxt ty) = HsForAllTy tvs [] (removeFuns ty)
removeContext ty		      = removeFuns ty

removeFuns (MonoFunTy _ ty) = removeFuns ty
removeFuns ty		    = ty


328
329
330
331
332
333
334
335
loadRule :: Module -> Bag GatedDecl 
	 -> RdrNameRuleDecl -> RnM d (Bag GatedDecl)
-- "Gate" the rule simply by whether the rule variable is
-- needed.  We can refine this later.
loadRule mod rules decl@(IfaceRuleDecl var body src_loc)
  = setModuleRn (moduleName mod) $
    mkImportedGlobalFromRdrName var		`thenRn` \ var_name ->
    returnRn ((unitNameSet var_name, (mod, RuleD decl)) `consBag` rules)
336
\end{code}
337

338

339
340
341
342
343
344
345
%********************************************************
%*							*
\subsection{Loading usage information}
%*							*
%********************************************************

\begin{code}
346
checkUpToDate :: ModuleName -> RnMG Bool		-- True <=> no need to recompile
347
checkUpToDate mod_name
348
349
350
351
  = getIfacesRn					`thenRn` \ ifaces ->
    findAndReadIface doc_str mod_name 
		     ImportByUser
		     (error "checkUpToDate")	`thenRn` \ (_, read_result) ->
sof's avatar
sof committed
352
353

	-- CHECK WHETHER WE HAVE IT ALREADY
354
    case read_result of
355
	Nothing -> 	-- Old interface file not found, so we'd better bail out
sof's avatar
sof committed
356
		    traceRn (sep [ptext SLIT("Didnt find old iface"), 
357
				  pprModuleName mod_name])	`thenRn_`
358
359
		    returnRn False

360
	Just (_, iface)
361
		-> 	-- Found it, so now check it
362
		    checkModUsage (pi_usages iface)
363
  where
364
	-- Only look in current directory, with suffix .hi
365
    doc_str = sep [ptext SLIT("need usage info from"), pprModuleName mod_name]
366

367
checkModUsage [] = returnRn True		-- Yes!  Everything is up to date!
368

369
370
checkModUsage ((mod_name, old_mod_vers, _, whats_imported) : rest)
  = loadInterface doc_str mod_name ImportBySystem	`thenRn` \ (mod, ifaces) ->
371
    let
372
373
374
	maybe_mod_vers = case lookupFM (iImpModInfo ifaces) mod_name of
			   Just (version, _, Just (_, _, _)) -> Just version
			   other			     -> Nothing
375
    in
376
377
378
379
    case maybe_mod_vers of {
	Nothing -> 	-- If we can't find a version number for the old module then
			-- bail out saying things aren't up to date
		traceRn (sep [ptext SLIT("Can't find version number for module"), 
380
381
			      pprModuleName mod_name])
		`thenRn_` returnRn False ;
382
383

	Just new_mod_vers ->
384
385
386

	-- If the module version hasn't changed, just move on
    if new_mod_vers == old_mod_vers then
387
388
	traceRn (sep [ptext SLIT("Module version unchanged:"), pprModuleName mod_name])
	`thenRn_` checkModUsage rest
389
    else
390
391
    traceRn (sep [ptext SLIT("Module version has changed:"), pprModuleName mod_name])
    `thenRn_`
392
393
394
395
396
397
398
399
400
401
	-- Module version changed, so check entities inside

	-- If the usage info wants to say "I imported everything from this module"
	--     it does so by making whats_imported equal to Everything
	-- In that case, we must recompile
    case whats_imported of {
      Everything -> traceRn (ptext SLIT("...and I needed the whole module"))	`thenRn_`
		    returnRn False;		   -- Bale out

      Specifically old_local_vers ->
402

403
	-- Non-empty usage list, so check item by item
404
    checkEntityUsage mod_name (iDecls ifaces) old_local_vers	`thenRn` \ up_to_date ->
405
    if up_to_date then
sof's avatar
sof committed
406
	traceRn (ptext SLIT("...but the bits I use haven't."))	`thenRn_`
407
408
409
	checkModUsage rest	-- This one's ok, so check the rest
    else
	returnRn False		-- This one failed, so just bail out now
410
    }}
411
  where
412
    doc_str = sep [ptext SLIT("need version info for"), pprModuleName mod_name]
413
414


415
checkEntityUsage mod decls [] 
416
417
  = returnRn True	-- Yes!  All up to date!

418
checkEntityUsage mod decls ((occ_name,old_vers) : rest)
419
  = mkImportedGlobalName mod occ_name 	`thenRn` \ name ->
420
    case lookupNameEnv decls name of
421
422

	Nothing       -> 	-- We used it before, but it ain't there now
423
424
			  putDocRn (sep [ptext SLIT("No longer exported:"), ppr name])
			  `thenRn_` returnRn False
425

426
	Just (new_vers,_,_,_) 	-- It's there, but is it up to date?
427
428
429
430
431
432
		| new_vers == old_vers
			-- Up to date, so check the rest
		-> checkEntityUsage mod decls rest

		| otherwise
			-- Out of date, so bale out
433
		-> putDocRn (sep [ptext SLIT("Out of date:"), ppr name])  `thenRn_`
434
		   returnRn False
435
436
437
\end{code}


438
439
440
441
442
%*********************************************************
%*							*
\subsection{Getting in a declaration}
%*							*
%*********************************************************
443

444
\begin{code}
445
446
447
448
449
450
451
452
453
454
455
456
importDecl :: Name -> RnMG (Maybe (Module, RdrNameHsDecl))
	-- Returns Nothing for 
	--	(a) wired in name
	--	(b) local decl
	--	(c) already slurped

importDecl name
  | isWiredInName name
  = returnRn Nothing
  | otherwise
  = getSlurped 				`thenRn` \ already_slurped ->
    if name `elemNameSet` already_slurped then
457
458
	returnRn Nothing	-- Already dealt with
    else
459
	if isLocallyDefined name then	-- Don't bring in decls from
460
					-- the renamed module's own interface file
461
		  addWarnRn (importDeclWarn name) `thenRn_`
462
463
464
		  returnRn Nothing
	else
	getNonWiredInDecl name
465
\end{code}
466

467
\begin{code}
468
469
getNonWiredInDecl :: Name -> RnMG (Maybe (Module, RdrNameHsDecl))
getNonWiredInDecl needed_name 
470
  = traceRn doc_str				`thenRn_`
471
    loadHomeInterface doc_str needed_name	`thenRn` \ ifaces ->
472
    case lookupNameEnv (iDecls ifaces) needed_name of
sof's avatar
sof committed
473

474
475
      Just (version,avail,_,decl)
	-> recordSlurp (Just version) avail	`thenRn_`
476
	   returnRn (Just decl)
477

478
479
480
      Nothing 	 	-- Can happen legitimately for "Optional" occurrences
	-> addErrRn (getDeclErr needed_name)	`thenRn_` 
	   returnRn Nothing
481
  where
482
     doc_str = ptext SLIT("need decl for") <+> ppr needed_name
483
484
\end{code}

485
486
487
@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,
488
489
\begin{itemize}
\item	if the wired-in name is a data type constructor or a data constructor, 
490
	it brings in the type constructor and all the data constructors; and
491
	marks as ``occurrences'' any free vars of the data con.
492

493
\item 	similarly for synonum type constructor
494

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

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


506
    
507
508
%*********************************************************
%*							*
sof's avatar
sof committed
509
\subsection{Getting what a module exports}
510
511
%*							*
%*********************************************************
512

513
@getInterfaceExports@ is called only for directly-imported modules.
514

515
\begin{code}
516
517
518
519
getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, Avails)
getInterfaceExports mod_name from
  = loadInterface doc_str mod_name from	`thenRn` \ (mod, ifaces) ->
    case lookupFM (iImpModInfo ifaces) mod_name of
520
521
522
523
524
	Nothing -> -- Not there; it must be that the interface file wasn't found;
		   -- the error will have been reported already.
		   -- (Actually loadInterface should put the empty export env in there
		   --  anyway, but this does no harm.)
		   returnRn (mod, [])
525

526
	Just (_, _, Just (mod, _, avails)) -> returnRn (mod, avails)
527
  where
528
    doc_str = sep [pprModuleName mod_name, ptext SLIT("is directly imported")]
sof's avatar
sof committed
529
530
531
532
533
\end{code}


%*********************************************************
%*							*
534
\subsection{Instance declarations are handled specially}
sof's avatar
sof committed
535
536
537
538
%*							*
%*********************************************************

\begin{code}
539
540
getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
getImportedInstDecls gates
541
  =    	-- First, load any orphan-instance modules that aren't aready loaded
542
	-- Orphan-instance modules are recorded in the module dependecnies
543
    getIfacesRn 					`thenRn` \ ifaces ->
sof's avatar
sof committed
544
    let
545
546
	orphan_mods =
	  [mod | (mod, (_, True, Nothing)) <- fmToList (iImpModInfo ifaces)]
sof's avatar
sof committed
547
    in
548
    loadOrphanModules orphan_mods			`thenRn_` 
549

550
	-- Now we're ready to grab the instance declarations
551
552
	-- Find the un-gated ones and return them, 
	-- removing them from the bag kept in Ifaces
553
    getIfacesRn 					`thenRn` \ ifaces ->
554
    let
555
556
557
	(decls, new_insts) = selectGated gates (iInsts ifaces)
    in
    setIfacesRn (ifaces { iInsts = new_insts })		`thenRn_`
558

559
    traceRn (sep [text "getImportedInstDecls:", 
560
		  nest 4 (fsep (map ppr gate_list)),
561
562
		  text "Slurped" <+> int (length decls) <+> text "instance declarations",
		  nest 4 (vcat (map ppr_brief_inst_decl decls))])	`thenRn_`
563
564
    returnRn decls
  where
565
566
567
568
569
570
571
    gate_list      = nameSetToList gates

    load_home gate | isLocallyDefined gate
		   = returnRn ()
		   | otherwise
		   = loadHomeInterface (ppr gate <+> text "is an instance gate") gate	`thenRn_`
		     returnRn ()
572

573
574
575
576
577
ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
  = case inst_ty of
	HsForAllTy _ _ tau -> ppr tau
	other		   -> ppr inst_ty

578
579
580
581
582
583
584
585
586
587
588
getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
getImportedRules
  = getIfacesRn 	`thenRn` \ ifaces ->
    let
	gates		   = iSlurp ifaces	-- Anything at all that's been slurped
	(decls, new_rules) = selectGated gates (iRules ifaces)
    in
    setIfacesRn (ifaces { iRules = new_rules })		`thenRn_`
    traceRn (sep [text "getImportedRules:", 
		  text "Slurped" <+> int (length decls) <+> text "rules"])	`thenRn_`
    returnRn decls
589

590
selectGated gates decl_bag
591
	-- Select only those decls whose gates are *all* in 'gates'
592
593
594
#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
595

596
597
598
  | otherwise
#endif
  = foldrBag select ([], emptyBag) decl_bag
599
  where
600
601
602
603
604
605
606
607
608
609
610
611
612
    select (reqd, decl) (yes, no)
	| isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
	| otherwise				     = (yes,      (reqd,decl) `consBag` no)

lookupFixity :: Name -> RnMS Fixity
lookupFixity name
  | isLocallyDefined name
  = getFixityEnv			`thenRn` \ local_fix_env ->
    case lookupNameEnv local_fix_env name of 
	Just (FixitySig _ fix _) -> returnRn fix
	Nothing		  	 -> returnRn defaultFixity

  | otherwise	-- Imported
613
  = loadHomeInterface doc name		`thenRn` \ ifaces ->
614
615
616
    case lookupNameEnv (iFixes ifaces) name of
	Just (FixitySig _ fix _) -> returnRn fix 
	Nothing 		 -> returnRn defaultFixity
617
  where
618
    doc = ptext SLIT("Checking fixity for") <+> ppr name
619
620
\end{code}

sof's avatar
sof committed
621
622
623
624
625
626
627

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

628
629
getImportVersions figures out
what the ``usage information'' for this moudule is;
630
631
that is, what it must record in its interface file as the things it uses.
It records:
632
633
634
635
636
637
\begin{itemize}
\item anything reachable from its body code
\item any module exported with a @module Foo@.
\end{itemize}
%
Why the latter?  Because if @Foo@ changes then this module's export list
638
639
640
641
642
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.

What about this? 
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
\begin{verbatim}
	module A( f, g ) where	|	module B( f ) where
	  import B( f )		|	  f = h 3
	  g = ...		|	  h = ...
\end{verbatim}
Should we record @B.f@ in @A@'s usages?  In fact we don't.  Certainly, if
anything about @B.f@ changes than anyone who imports @A@ should be recompiled;
they'll get an early exit if they don't use @B.f@.  However, 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.  So there are two things going on when compiling module @A@:
\begin{enumerate}
\item Are @A.o@ and @A.hi@ correct?  Then we can bale out early.
\item Should modules that import @A@ be recompiled?
\end{enumerate}
For (1) it is slightly harmful to record @B.f@ in @A@'s usages,
because a change in @B.f@'s version will provoke full recompilation of @A@,
producing an identical @A.o@,
and @A.hi@ differing only in its usage-version of @B.f@
661
(and this usage-version info isn't used by any importer).
662
663
664
665
666
667
668
669
670
671

For (2), because of the tricky @B.h@ question above,
we ensure that @A.hi@ is touched
(even if identical to its previous version)
if A's recompilation was triggered by an imported @.hi@ file date change.
Given that, there's no need to record @B.f@ in @A@'s usages.

On the other hand, if @A@ exports @module B@,
then we {\em do} count @module B@ among @A@'s usages,
because we must recompile @A@ to ensure that @A.hi@ changes appropriately.
672

673
\begin{code}
674
getImportVersions :: ModuleName			-- Name of this module
675
		  -> Maybe [IE any]		-- Export list for this module
676
		  -> RnMG (VersionInfo Name)	-- Version info for these names
677

678
getImportVersions this_mod exports
679
680
  = getIfacesRn					`thenRn` \ ifaces ->
    let
681
682
	mod_map   = iImpModInfo ifaces
	imp_names = iVSlurp     ifaces
683

684
	-- mv_map groups together all the things imported from a particular module.
685
	mv_map1, mv_map2 :: FiniteMap ModuleName (WhatsImported Name)
686

687
		-- mv_map1 records all the modules that have a "module M"
688
		-- in this module's export list with an "Everything" 
689
690
691
692
693
	mv_map1 = foldr add_mod emptyFM export_mods

		-- mv_map2 adds the version numbers of things exported individually
	mv_map2 = foldr add_mv mv_map1 imp_names

694
695
696
697
698
699
	-- Build the result list by adding info for each module.
	-- For (a) library modules
	--     (b) source-imported modules
	-- we do something special.  We don't want to record detailed usage information.
	-- Indeed we don't want to record them at all unless they contain orphans,
	-- which we must never lose track of.
700
	mk_version_info mod_name (version, has_orphans, cts) so_far
701
702
703
704
705
706
707
708
709
	   | lib_or_source_imported && not has_orphans
	   = so_far	-- Don't record any usage info for this module
	   
	   | lib_or_source_imported	-- Has orphans; record the module but not
					-- detailed version information for the imports
	   = (mod_name, version, has_orphans, Specifically []) : so_far

	   | otherwise 
	   = (mod_name, version, has_orphans, whats_imported) : so_far
710
711
712
713
714
	   where
	     whats_imported = case lookupFM mv_map2 mod_name of
				Just wi -> wi
				Nothing -> Specifically []

715
716
717
	     lib_or_source_imported = case cts of
					Just (mod, boot_import, _) -> isLibModule mod || boot_import
					Nothing			   -> False
sof's avatar
sof committed
718
    in
719
    returnRn (foldFM mk_version_info [] mod_map)
720
721
722
723
724
  where
     export_mods = case exports of
			Nothing -> []
			Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]

725
     add_mv v@(name, version) mv_map
726
      = addToFM_C add_item mv_map mod (Specifically [v]) 
727
	where
728
	 mod = moduleName (nameModule name)
729

730
731
732
         add_item Everything        _ = Everything
         add_item (Specifically xs) _ = Specifically (v:xs)

733
     add_mod mod mv_map = addToFM mv_map mod Everything
734
\end{code}
735

sof's avatar
sof committed
736
\begin{code}
737
getSlurped
sof's avatar
sof committed
738
  = getIfacesRn 	`thenRn` \ ifaces ->
739
    returnRn (iSlurp ifaces)
sof's avatar
sof committed
740

741
742
743
recordSlurp maybe_version avail
  = getIfacesRn 	`thenRn` \ ifaces@(Ifaces { iSlurp  = slurped_names,
					            iVSlurp = imp_names }) ->
sof's avatar
sof committed
744
745
746
747
    let
	new_slurped_names = addAvailToNameSet slurped_names avail

	new_imp_names = case maybe_version of
sof's avatar
sof committed
748
			   Just version	-> (availName avail, version) : imp_names
sof's avatar
sof committed
749
750
			   Nothing      -> imp_names
    in
751
752
    setIfacesRn (ifaces { iSlurp  = new_slurped_names,
			  iVSlurp = new_imp_names })
sof's avatar
sof committed
753
754
755
\end{code}


756
757
758
759
760
761
762
763
764
765
%*********************************************************
%*							*
\subsection{Getting binders out of a declaration}
%*							*
%*********************************************************

@getDeclBinders@ returns the names for a @RdrNameHsDecl@.
It's used for both source code (from @availsFromDecl@) and interface files
(from @loadDecl@).

766
767
It doesn't deal with source-code specific things: @ValD@, @DefD@.  They
are handled by the sourc-code specific stuff in @RnNames@.
768

769
\begin{code}
770
getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name)	-- New-name function
771
		-> RdrNameHsDecl
772
		-> RnM d (Maybe AvailInfo)
773

774
getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ src_loc))
775
776
  = new_name tycon src_loc			`thenRn` \ tycon_name ->
    getConFieldNames new_name condecls		`thenRn` \ sub_names ->
777
    returnRn (Just (AvailTC tycon_name (tycon_name : nub sub_names)))
sof's avatar
sof committed
778
779
	-- The "nub" is because getConFieldNames can legitimately return duplicates,
	-- when a record declaration has the same field in multiple constructors
780

781
getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
782
  = new_name tycon src_loc		`thenRn` \ tycon_name ->
783
    returnRn (Just (AvailTC tycon_name [tycon_name]))
784

785
getDeclBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ _ _ _ src_loc))
786
  = new_name cname src_loc			`thenRn` \ class_name ->
787
788

	-- Record the names for the class ops
sof's avatar
sof committed
789
    let
sof's avatar
sof committed
790
791
	-- just want class-op sigs
	op_sigs = filter isClassOpSig sigs
sof's avatar
sof committed
792
    in
sof's avatar
sof committed
793
    mapRn (getClassOpNames new_name) op_sigs	`thenRn` \ sub_names ->
794

795
    returnRn (Just (AvailTC class_name (class_name : sub_names)))
796
797
798

getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
  = new_name var src_loc			`thenRn` \ var_name ->
799
    returnRn (Just (Avail var_name))
800

801
getDeclBinders new_name (FixD _)  = returnRn Nothing
sof's avatar
sof committed
802
803
804
805
806
807
808
809
810
811
812

    -- foreign declarations
getDeclBinders new_name (ForD (ForeignDecl nm kind _ dyn _ loc))
  | binds_haskell_name kind dyn
  = new_name nm loc		    `thenRn` \ name ->
    returnRn (Just (Avail name))

  | otherwise -- a foreign export
  = lookupImplicitOccRn nm `thenRn_` 
    returnRn Nothing

813
814
getDeclBinders new_name (DefD _)  = returnRn Nothing
getDeclBinders new_name (InstD _) = returnRn Nothing
815
getDeclBinders new_name (RuleD _) = returnRn Nothing
816

sof's avatar
sof committed
817
818
819
820
binds_haskell_name (FoImport _) _   = True
binds_haskell_name FoLabel      _   = True
binds_haskell_name FoExport  ext_nm = isDynamic ext_nm

821
----------------
822
getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
823
824
825
  = mapRn (\n -> new_name n src_loc) (con:fields)	`thenRn` \ cfs ->
    getConFieldNames new_name rest			`thenRn` \ ns  -> 
    returnRn (cfs ++ ns)
826
  where
827
828
    fields = concat (map fst fielddecls)

sof's avatar
sof committed
829
getConFieldNames new_name (ConDecl con _ _ condecl src_loc : rest)
sof's avatar
sof committed
830
  = new_name con src_loc		`thenRn` \ n ->
sof's avatar
sof committed
831
832
833
834
835
    (case condecl of
      NewCon _ (Just f) -> 
        new_name f src_loc `thenRn` \ new_f ->
	returnRn [n,new_f]
      _ -> returnRn [n])		`thenRn` \ nn ->
sof's avatar
sof committed
836
    getConFieldNames new_name rest	`thenRn` \ ns -> 
sof's avatar
sof committed
837
    returnRn (nn ++ ns)
sof's avatar
sof committed
838

839
getConFieldNames new_name [] = returnRn []
840

841
getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
842
843
\end{code}

844
845
@getDeclSysBinders@ gets the implicit binders introduced by a decl.
A the moment that's just the tycon and datacon that come with a class decl.
846
847
They aren't returned by @getDeclBinders@ because they aren't in scope;
but they {\em should} be put into the @DeclsMap@ of this module.
848

849
850
851
852
Note that this excludes the default-method names of a class decl,
and the dict fun of an instance decl, because both of these have 
bindings of their own elsewhere.

853
\begin{code}
854
855
856
857
858
getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ sigs _ _ tname dname snames src_loc))
  = new_name dname src_loc		    	    	`thenRn` \ datacon_name ->
    new_name tname src_loc		        	`thenRn` \ tycon_name ->
    sequenceRn [new_name n src_loc | n <- snames]	`thenRn` \ scsel_names ->
    returnRn (tycon_name : datacon_name : scsel_names)
859
860
861
862

getDeclSysBinders new_name other_decl
  = returnRn []
\end{code}
863

864
865
866
867
868
869
%*********************************************************
%*							*
\subsection{Reading an interface file}
%*							*
%*********************************************************

870
\begin{code}
871
872
873
874
875
876
877
findAndReadIface :: SDoc -> ModuleName -> WhereFrom 
		 -> Bool	-- Only relevant for SystemImport
				-- True  <=> Look for a .hi file
				-- False <=> Look for .hi-boot file unless there's
				--	     a library .hi file
		 -> RnM d (Bool, Maybe (Module, ParsedIface))
	-- Bool is True if the interface actually read was a .hi-boot one
878
879
	-- Nothing <=> file not found, or unreadable, or illegible
	-- Just x  <=> successfully found and parsed 
880

881
findAndReadIface doc_str mod_name from hi_file
882
  = traceRn trace_msg			`thenRn_`
883
884
885
      -- we keep two maps for interface files,
      -- one for 'normal' ones, the other for .hi-boot files,
      -- hence the need to signal which kind we're interested.
886
887
888
889

    getHiMaps			`thenRn` \ hi_maps ->
	
    case find_path from hi_maps of
890
         -- Found the file
891
892
       (hi_boot, Just (fpath, mod)) -> traceRn (ptext SLIT("...reading from") <+> text fpath)
				       `thenRn_`
893
894
895
896
				       readIface mod fpath	`thenRn` \ result ->
				       returnRn (hi_boot, result)
       (hi_boot, Nothing)           -> traceRn (ptext SLIT("...not found"))	`thenRn_`
				       returnRn (hi_boot, Nothing)
897
  where
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
    find_path ImportByUser       (hi_map, _)     = (False, lookupFM hi_map mod_name)
    find_path ImportByUserSource (_, hiboot_map) = (True,  lookupFM hiboot_map mod_name)

    find_path ImportBySystem     (hi_map, hiboot_map)
      | hi_file
      =		-- If the module we seek is in our dependent set, 
		-- Look for a .hi file
         (False, lookupFM hi_map mod_name)

      | otherwise
		-- Check if there's a library module of that name
		-- If not, look for an hi-boot file
      = case lookupFM hi_map mod_name of
	   stuff@(Just (_, mod)) | isLibModule mod -> (False, stuff)
	   other		 		   -> (True, lookupFM hiboot_map mod_name)
sof's avatar
sof committed
913

sof's avatar
sof committed
914
    trace_msg = sep [hsep [ptext SLIT("Reading"), 
915
			   ppr from,
sof's avatar
sof committed
916
			   ptext SLIT("interface for"), 
917
			   pprModuleName mod_name <> semi],
sof's avatar
sof committed
918
		     nest 4 (ptext SLIT("reason:") <+> doc_str)]
919
\end{code}
920

sof's avatar
sof committed
921
@readIface@ tries just the one file.
922

923
\begin{code}
924
readIface :: Module -> String -> RnM d (Maybe (Module, ParsedIface))
925
926
	-- Nothing <=> file not found, or unreadable, or illegible
	-- Just x  <=> successfully found and parsed 
927
readIface the_mod file_path
928
  = ioToRnM (hGetStringBuffer False file_path)       `thenRn` \ read_result ->
929
    case read_result of
sof's avatar
sof committed
930
	Right contents	  -> 
931
932
933
934
935
936
937
             case parseIface contents
			PState{ bol = 0#, atbol = 1#,
				context = [],
				glasgow_exts = 1#,
				loc = mkSrcLoc (mkFastString file_path) 1 } of
	          PFailed err                    -> failWithRn Nothing err 
		  POk _  (PIface mod_nm iface) ->
938
939
940
941
942
943
944
		    warnCheckRn (mod_nm == moduleName the_mod)
			(hsep [ ptext SLIT("Something is amiss; requested module name")
		        , pprModule the_mod
		        , ptext SLIT("differs from name found in the interface file ")
			, pprModuleName mod_nm
			])
		    `thenRn_` returnRn (Just (the_mod, iface))
sof's avatar
sof committed
945
946
947
948

        Left err
	  | isDoesNotExistError err -> returnRn Nothing
	  | otherwise               -> failWithRn Nothing (cannaeReadFile file_path err)
949
\end{code}
950

951
%*********************************************************
sof's avatar
sof committed
952
%*						 	 *
953
\subsection{Errors}
sof's avatar
sof committed
954
%*							 *
955
%*********************************************************
956

957
\begin{code}
958
959
960
961
962
963
noIfaceErr filename boot_file
  = hsep [ptext SLIT("Could not find valid"), boot, 
	  ptext SLIT("interface file"), quotes (pprModule filename)]
  where
    boot | boot_file = ptext SLIT("[boot]")
	 | otherwise = empty
964

965
cannaeReadFile file err
sof's avatar
sof committed
966
  = hcat [ptext SLIT("Failed in reading file: "), 
967
          text file, 
sof's avatar
sof committed
968
	  ptext SLIT("; error="), 
969
	  text (show err)]
970

971
972
getDeclErr name
  = ptext SLIT("Failed to find interface decl for") <+> quotes (ppr name)
973

974
getDeclWarn name loc
975
976
  = sep [ptext SLIT("Failed to find (optional) interface decl for") <+> quotes (ppr name),
	 ptext SLIT("desired at") <+> ppr loc]
sof's avatar
sof committed
977

978
importDeclWarn name
979
980
981
982
  = 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
983
	] $$
984
    hsep [ptext SLIT("name:"), quotes (ppr name)]
sof's avatar
sof committed
985

986
warnRedundantSourceImport mod_name
987
988
  = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
          <+> quotes (pprModuleName mod_name)
989
\end{code}