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

\begin{code}
#include "HsVersions.h"

module RnIfaces (
10
11
12
	getInterfaceExports,
	getImportedInstDecls,
	getSpecialInstModules,
13
14
	importDecl, recordSlurp,
	getImportVersions, 
15
16
17
18
19

	checkUpToDate,

	getDeclBinders,
	mkSearchPath
20
21
    ) where

22
IMP_Ubiq()
23
24


25
26
27
28
29
import CmdLineOpts	( opt_HiSuffix, opt_HiSuffixPrelude )
import HsSyn		( HsDecl(..), TyDecl(..), ClassDecl(..), HsTyVar, Bind, HsExpr, Sig(..), HsType(..),
			  HsBinds(..), MonoBinds, DefaultDecl, ConDecl(..), BangType, IfaceSig(..),
			  FixityDecl(..), Fixity, Fake, InPat, InstDecl(..), SYN_IE(Version), HsIdInfo,
			  IE(..)
30
31
32
33
34
			)
import HsPragmas	( noGenPragmas )
import RdrHsSyn		( SYN_IE(RdrNameHsDecl), SYN_IE(RdrNameInstDecl), 
			  RdrName, rdrNameOcc
			)
35
36
37
import RnEnv		( newGlobalName, lookupRn, addImplicitOccsRn, 
			  availName, availNames, addAvailToNameSet, pprAvail
			)
38
import RnSource		( rnHsType )
39
import RnMonad
40
import ParseIface	( parseIface )
41

42
import ErrUtils		( SYN_IE(Error), SYN_IE(Warning) )
43
import FiniteMap	( FiniteMap, emptyFM, unitFM, lookupFM, addToFM, addToFM_C, addListToFM, fmToList )
44
45
46
import Name		( Name {-instance NamedThing-}, Provenance, OccName(..),
			  modAndOcc, occNameString, moduleString, pprModule,
			  NameSet(..), emptyNameSet, unionNameSets, nameSetToList,
47
			  minusNameSet, mkNameSet, elemNameSet,
48
49
50
51
52
53
54
			  isWiredInName, maybeWiredInTyConName, maybeWiredInIdName
			 )
import Id		( GenId, Id(..), idType, dataConTyCon, isDataCon )
import TyCon		( TyCon, tyConDataCons, isSynTyCon, getSynTyConDefn )
import Type		( namesOfType )
import TyVar		( GenTyVar )
import SrcLoc		( mkIfaceSrcLoc )
55
import PrelMods		( gHC__, isPreludeModule )
56
57
58
import Bag
import Maybes		( MaybeErr(..), expectJust, maybeToBool )
import ListSetOps	( unionLists )
59
import Pretty
60
import PprStyle		( PprStyle(..) )
61
62
63
import Util		( pprPanic, pprTrace )
import StringBuffer     ( StringBuffer, hGetStringBuffer, freeStringBuffer )

64
65
\end{code}

66
67


68
69
70
71
72
%*********************************************************
%*							*
\subsection{Loading a new interface file}
%*							*
%*********************************************************
73

74
\begin{code}
75
76
77
loadInterface :: Pretty -> Module -> RnMG Ifaces
loadInterface doc_str load_mod 
  = getIfacesRn 		`thenRn` \ ifaces ->
78
    let
79
	Ifaces this_mod mod_vers_map export_envs decls all_names imp_names insts inst_mods = ifaces
80
    in
81
	-- CHECK WHETHER WE HAVE IT ALREADY
82
    if maybeToBool (lookupFM export_envs load_mod) 
83
84
85
86
87
88
89
90
91
92
93
    then
	returnRn ifaces		-- Already in the cache; don't re-read it
    else

	-- READ THE MODULE IN
    findAndReadIface doc_str load_mod		`thenRn` \ read_result ->
    case read_result of {
	-- Check for not found
	Nothing -> 	-- Not found, so add an empty export env to the Ifaces map
			-- so that we don't look again
		   let
94
95
96
97
			new_export_envs = addToFM export_envs load_mod ([],[])
			new_ifaces = Ifaces this_mod mod_vers_map
					    new_export_envs
					    decls all_names imp_names insts inst_mods
98
99
100
101
102
		   in
		   setIfacesRn new_ifaces		`thenRn_`
		   failWithRn new_ifaces (noIfaceErr load_mod) ;

	-- Found and parsed!
103
	Just (ParsedIface _ mod_vers usages exports rd_inst_mods fixs rd_decls rd_insts) ->
104
105

	-- LOAD IT INTO Ifaces
106
107
108
    mapRn loadExport exports				`thenRn` \ avails_s ->
    foldlRn (loadDecl load_mod) decls rd_decls		`thenRn` \ new_decls ->
    foldlRn (loadInstDecl load_mod) insts rd_insts	`thenRn` \ new_insts ->
109
    let
110
	 export_env = (concat avails_s, fixs)
111
112
113
114
115
116

			-- Exclude this module from the "special-inst" modules
	 new_inst_mods = inst_mods `unionLists` (filter (/= this_mod) rd_inst_mods)

	 new_ifaces = Ifaces this_mod
			     (addToFM mod_vers_map load_mod mod_vers)
117
118
119
120
			     (addToFM export_envs load_mod export_env)
			     new_decls
			     all_names imp_names
			     new_insts
121
			     new_inst_mods 
122
    in
123
124
125
126
    setIfacesRn new_ifaces		`thenRn_`
    returnRn new_ifaces
    }

127
128
129
loadExport :: ExportItem -> RnMG [AvailInfo]
loadExport (mod, entities)
  = mapRn load_entity entities
130
131
132
  where
    new_name occ = newGlobalName mod occ

133
134
135
136
137
-- The communcation between this little code fragment and the "entity" rule
-- in ParseIface.y is a bit gruesome.  The idea is that things which are
-- destined to be AvailTCs show up as (occ, [non-empty-list]), whereas
-- things destined to be Avails show up as (occ, [])

138
139
    load_entity (occ, occs)
      =	new_name occ 		`thenRn` \ name ->
140
141
142
143
144
	if null occs then
		returnRn (Avail name)
	else
	        mapRn new_name occs 	`thenRn` \ names ->
	        returnRn (AvailTC name names)
145

146
loadDecl :: Module -> DeclsMap
147
	 -> (Version, RdrNameHsDecl)
148
149
150
	 -> RnMG DeclsMap
loadDecl mod decls_map (version, decl)
  = getDeclBinders new_implicit_name decl	`thenRn` \ avail ->
151
    returnRn (addListToFM decls_map
152
			  [(name,(version,avail,decl)) | name <- availNames avail]
153
    )
154
  where
155
156
    new_implicit_name rdr_name loc = newGlobalName mod (rdrNameOcc rdr_name)

157
158
159
160
loadInstDecl :: Module
	     -> Bag IfaceInst
	     -> RdrNameInstDecl
	     -> RnMG (Bag IfaceInst)
161
loadInstDecl mod_name insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
162
163
164
165
166
167
168
169
  = 
	-- 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 ...
170
	--
171
172
173
174
175
176
177
178
179
180
181
182
183
	-- Here the gates are Baz and T, but *not* Foo.
    let 
	munged_inst_ty = case inst_ty of
				HsForAllTy tvs cxt ty -> HsForAllTy tvs [] ty
				HsPreForAllTy cxt ty  -> HsPreForAllTy [] ty
				other		      -> inst_ty
    in
	-- We find the gates by renaming the instance type with in a 
	-- and returning the occurrence pool.
    initRnMS emptyRnEnv mod_name InterfaceMode (
        findOccurrencesRn (rnHsType munged_inst_ty)	
    )						`thenRn` \ gate_names ->
    returnRn (((mod_name, decl), gate_names) `consBag` insts)
184
\end{code}
185

186

187
188
189
190
191
192
193
194
195
196
%********************************************************
%*							*
\subsection{Loading usage information}
%*							*
%********************************************************

\begin{code}
checkUpToDate :: Module -> RnMG Bool		-- True <=> no need to recompile
checkUpToDate mod_name
  = findAndReadIface doc_str mod_name		`thenRn` \ read_result ->
197
    case read_result of
198
199
200
	Nothing -> 	-- Old interface file not found, so we'd better bail out
		    traceRn (ppSep [ppPStr SLIT("Didnt find old iface"), 
				    pprModule PprDebug mod_name])	`thenRn_`
201
202
203
204
205
		    returnRn False

	Just (ParsedIface _ _ usages _ _ _ _ _) 
		-> 	-- Found it, so now check it
		    checkModUsage usages
206
  where
207
	-- Only look in current directory, with suffix .hi
208
    doc_str = ppSep [ppPStr SLIT("Need usage info from"), pprModule PprDebug mod_name]
209
210


211
checkModUsage [] = returnRn True		-- Yes!  Everything is up to date!
212

213
214
215
checkModUsage ((mod, old_mod_vers, old_local_vers) : rest)
  = loadInterface doc_str mod		`thenRn` \ ifaces ->
    let
216
217
	Ifaces _ mod_vers _ decls _ _ _ _ = ifaces
	maybe_new_mod_vers = lookupFM mod_vers mod
218
	Just new_mod_vers  = maybe_new_mod_vers
219
    in
220
	-- If we can't find a version number for the old module then
221
	-- bail out saying things aren't up to date
222
223
224
225
226
227
    if not (maybeToBool maybe_new_mod_vers) then
	returnRn False
    else

	-- If the module version hasn't changed, just move on
    if new_mod_vers == old_mod_vers then
228
	traceRn (ppSep [ppPStr SLIT("Module version unchanged:"), pprModule PprDebug mod])	`thenRn_`
229
230
	checkModUsage rest
    else
231
    traceRn (ppSep [ppPStr SLIT("Module version has changed:"), pprModule PprDebug mod])	`thenRn_`
232

233
	-- New module version, so check entities inside
234
    checkEntityUsage mod decls old_local_vers	`thenRn` \ up_to_date ->
235
    if up_to_date then
236
	traceRn (ppPStr SLIT("...but the bits I use haven't."))	`thenRn_`
237
238
239
240
	checkModUsage rest	-- This one's ok, so check the rest
    else
	returnRn False		-- This one failed, so just bail out now
  where
241
    doc_str = ppSep [ppPStr SLIT("need version info for"), pprModule PprDebug mod]
242
243


244
checkEntityUsage mod decls [] 
245
246
  = returnRn True	-- Yes!  All up to date!

247
checkEntityUsage mod decls ((occ_name,old_vers) : rest)
248
  = newGlobalName mod occ_name		`thenRn` \ name ->
249
    case lookupFM decls name of
250
251

	Nothing       -> 	-- We used it before, but it ain't there now
252
			  traceRn (ppSep [ppPStr SLIT("...and this no longer exported:"), ppr PprDebug name])	`thenRn_`
253
254
			  returnRn False

255
256
257
258
259
260
261
262
263
	Just (new_vers,_,_) 	-- It's there, but is it up to date?
		| new_vers == old_vers
			-- Up to date, so check the rest
		-> checkEntityUsage mod decls rest

		| otherwise
			-- Out of date, so bale out
		-> traceRn (ppSep [ppPStr SLIT("...and this is out of date:"), ppr PprDebug name])  `thenRn_`
		   returnRn False
264
265
266
\end{code}


267
268
269
270
271
%*********************************************************
%*							*
\subsection{Getting in a declaration}
%*							*
%*********************************************************
272

273
\begin{code}
274
275
276
277
278
279
importDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
	-- Returns Nothing for a wired-in or already-slurped decl

importDecl name necessity
  = checkSlurped name			`thenRn` \ already_slurped ->
    if already_slurped then
280
	-- traceRn (ppSep [ppStr "Already slurped:", ppr PprDebug name])	`thenRn_`
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
	returnRn Nothing	-- Already dealt with
    else
    if isWiredInName name then
	getWiredInDecl name
    else 
       getIfacesRn 		`thenRn` \ ifaces ->
       let
         Ifaces this_mod _ _ _ _ _ _ _ = ifaces
         (mod,_) = modAndOcc name
       in
       if mod == this_mod  then    -- Don't bring in decls from
	  pprTrace "importDecl wierdness:" (ppr PprDebug name) $
	  returnRn Nothing         -- the renamed module's own interface file
			           -- 
       else
	getNonWiredInDecl name necessity
297

298
\end{code}
299

300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
\begin{code}
getNonWiredInDecl :: Name -> Necessity -> RnMG (Maybe RdrNameHsDecl)
getNonWiredInDecl name necessity
  = traceRn doc_str 			`thenRn_`
    loadInterface doc_str mod		`thenRn` \ (Ifaces _ _ _ decls _ _ _ _) ->
    case lookupFM decls name of

      Just (version,avail,decl) -> recordSlurp (Just version) avail	`thenRn_`
				   returnRn (Just decl)

      Nothing -> 	-- Can happen legitimately for "Optional" occurrences
		   case necessity of { 
				Optional -> addWarnRn (getDeclWarn name);
				other	 -> addErrRn  (getDeclErr  name)
		   }						`thenRn_` 
		   returnRn Nothing
316
  where
317
     doc_str = ppSep [ppPStr SLIT("Need decl for"), ppr PprDebug name]
318
     (mod,_) = modAndOcc name
319
320
\end{code}

321
322
323
@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,
324

325
326
327
  *	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.
328

329
  * 	similarly for synonum type constructor
330

331
332
  * 	if the wired-in name is another wired-in Id, it marks as "occurrences"
	the free vars of the Id's type.
333

334
335
  *	it loads the interface file for the wired-in thing for the
	sole purpose of making sure that its instance declarations are available
336

337
338
339
340
341
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.
	
\begin{code}
getWiredInDecl name
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
  = get_wired				`thenRn` \ avail ->
    recordSlurp Nothing avail		`thenRn_`

   	-- Force in the home module in case it has instance decls for
	-- the thing we are interested in.
	--
	-- Mini hack 1: no point for non-tycons/class; and if we
	-- do this we find PrelNum trying to import PackedString,
	-- because PrelBase's .hi file mentions PackedString.unpackString
	-- But PackedString.hi isn't built by that point!
	--
	-- Mini hack 2; GHC is guaranteed not to have
	-- instance decls, so it's a waste of time to read it
	--
	-- NB: We *must* look at the availName of the slurped avail, 
	-- not the name passed to getWiredInDecl!  Why?  Because if a data constructor 
	-- or class op is passed to getWiredInDecl we'll pull in the whole data/class
	-- decl, and recordSlurp will record that fact.  But since the data constructor
	-- isn't a tycon/class we won't force in the home module.  And even if the
	-- type constructor/class comes along later, loadDecl will say that it's already
	-- been slurped, so getWiredInDecl won't even be called.  Pretty obscure bug, this was.
    let
	main_name  = availName avail
	main_is_tc = case avail of { AvailTC _ _ -> True; Avail _ -> False }
	(mod,_)    = modAndOcc main_name
	doc_str    = ppSep [ppPStr SLIT("Need home module for wired in thing"), ppr PprDebug name]
    in
    (if not main_is_tc || mod == gHC__ then
	returnRn ()		
371
372
373
    else
	loadInterface doc_str mod	`thenRn_`
	returnRn ()
374
375
376
    )				 	`thenRn_`

    returnRn Nothing		-- No declaration to process further
377
378
  where

379
380
381
382
383
384
385
386
387
    get_wired | is_tycon			-- ... a type constructor
	      = get_wired_tycon the_tycon

	      | (isDataCon the_id) 		-- ... a wired-in data constructor
	      = get_wired_tycon (dataConTyCon the_id)

	      | otherwise			-- ... a wired-in non data-constructor
	      = get_wired_id the_id

388
389
390
391
392
393
    maybe_wired_in_tycon = maybeWiredInTyConName name
    is_tycon		 = maybeToBool maybe_wired_in_tycon
    maybe_wired_in_id    = maybeWiredInIdName    name
    Just the_tycon	 = maybe_wired_in_tycon
    Just the_id 	 = maybe_wired_in_id

394

395
396
get_wired_id id
  = addImplicitOccsRn (nameSetToList id_mentioned)	`thenRn_`
397
    returnRn (Avail (getName id))
398
  where
399
    id_mentioned = namesOfType (idType id)
400

401
402
403
get_wired_tycon tycon 
  | isSynTyCon tycon
  = addImplicitOccsRn (nameSetToList mentioned)		`thenRn_`
404
    returnRn (Avail (getName tycon))
405
406
407
  where
    (tyvars,ty) = getSynTyConDefn tycon
    mentioned = namesOfType ty `minusNameSet` mkNameSet (map getName tyvars)
408

409
410
411
get_wired_tycon tycon 
  | otherwise		-- data or newtype
  = addImplicitOccsRn (nameSetToList mentioned)		`thenRn_`
412
    returnRn (AvailTC tycon_name (tycon_name : map getName data_cons))
413
  where
414
415
416
    tycon_name = getName tycon
    data_cons  = tyConDataCons tycon
    mentioned  = foldr (unionNameSets . namesOfType . idType) emptyNameSet data_cons
417
418
419
\end{code}


420
421
422
423
424
425
\begin{code}
checkSlurped name
  = getIfacesRn 	`thenRn` \ (Ifaces _ _ _ _ slurped_names _ _ _) ->
    returnRn (name `elemNameSet` slurped_names)

recordSlurp maybe_version avail
426
427
  = -- traceRn (ppSep [ppStr "Record slurp:", pprAvail PprDebug avail])	`thenRn_`
    getIfacesRn 	`thenRn` \ ifaces ->
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
    let
	Ifaces this_mod mod_vers export_envs decls slurped_names imp_names insts inst_mods = ifaces
	new_slurped_names = addAvailToNameSet slurped_names avail

	new_imp_names = case maybe_version of
			   Just version -> (availName avail, version) : imp_names
			   Nothing      -> imp_names

	new_ifaces = Ifaces this_mod mod_vers export_envs decls 
			    new_slurped_names 
			    new_imp_names
			    insts
			    inst_mods
    in
    setIfacesRn new_ifaces
\end{code}
    
445
446
447
448
449
%*********************************************************
%*							*
\subsection{Getting other stuff}
%*							*
%*********************************************************
450
451

\begin{code}
452
453
getInterfaceExports :: Module -> RnMG (Avails, [(OccName,Fixity)])
getInterfaceExports mod
454
  = loadInterface doc_str mod		`thenRn` \ (Ifaces _ _ export_envs _ _ _ _ _) ->
455
456
457
458
459
460
461
462
463
    case lookupFM export_envs mod of
	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 ([],[])

	Just stuff -> returnRn stuff
  where
464
    doc_str = ppSep [pprModule PprDebug mod, ppPStr SLIT("is directly imported")]
465
466


467
getImportedInstDecls :: RnMG [(Module,RdrNameInstDecl)]
468
469
470
471
getImportedInstDecls
  = 	-- First load any special-instance modules that aren't aready loaded
    getSpecialInstModules 			`thenRn` \ inst_mods ->
    mapRn load_it inst_mods			`thenRn_`
472

473
	-- Now we're ready to grab the instance declarations
474
475
476
	-- Find the un-gated ones and return them, 
	-- removing them from the bag kept in Ifaces
    getIfacesRn 	`thenRn` \ ifaces ->
477
    let
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
	Ifaces this_mod mod_vers export_envs decls slurped_names imp_names insts inst_mods = ifaces

		-- An instance decl is ungated if all its gates have been slurped
        select_ungated :: IfaceInst					-- A gated inst decl

		       -> ([(Module, RdrNameInstDecl)], [IfaceInst])	-- Accumulator

		       -> ([(Module, RdrNameInstDecl)], 		-- The ungated ones
			   [IfaceInst]) 				-- Still gated, but with
									-- depeleted gates
	select_ungated (decl,gates) (ungated_decls, gated_decls)
	  | null remaining_gates
	  = (decl : ungated_decls, gated_decls)
	  | otherwise
	  = (ungated_decls, (decl, remaining_gates) : gated_decls)
	  where
	    remaining_gates = filter (not . (`elemNameSet` slurped_names)) gates

	(un_gated_insts, still_gated_insts) = foldrBag select_ungated ([], []) insts
	
	new_ifaces = Ifaces this_mod mod_vers export_envs decls slurped_names imp_names
			    (listToBag still_gated_insts)
			    inst_mods
501
    in
502
503
    setIfacesRn new_ifaces	`thenRn_`
    returnRn un_gated_insts
504
  where
505
    load_it mod = loadInterface (doc_str mod) mod
506
507
    doc_str mod = ppSep [pprModule PprDebug mod, ppPStr SLIT("is a special-instance module")]

508
509
510
511
512

getSpecialInstModules :: RnMG [Module]
getSpecialInstModules 
  = getIfacesRn						`thenRn` \ ifaces ->
    let
513
	 Ifaces _ _ _ _ _ _ _ inst_mods = ifaces
514
515
    in
    returnRn inst_mods
516
517
\end{code}

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
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:
	- anything reachable from its body code
	- any module exported with a "module Foo".

Why the latter?  Because if Foo changes then this module's export list
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? 
	module A( f, g ) where		module B( f ) where
	  import B( f )			  f = h 3
	  g = ...			  h = ...

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:

1.  Are A.o and A.hi correct?  Then we can bale out early.
2.  Should modules that import A be recompiled?

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 (which isn't used by any importer).

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 *do* count module B among
A's usages, because we must recompile A to ensure that A.hi changes appropriately.

555
\begin{code}
556
557
getImportVersions :: Module			-- Name of this module
		  -> Maybe [IE any]		-- Export list for this module
558
		  -> RnMG (VersionInfo Name)	-- Version info for these names
559

560
getImportVersions this_mod exports
561
562
  = getIfacesRn					`thenRn` \ ifaces ->
    let
563
564
565
566
567
568
569
570
571
572
573
574
	 Ifaces _ mod_versions_map _ _ _ imp_names _ _ = ifaces
	 mod_version mod = expectJust "import_versions" (lookupFM mod_versions_map mod)

	 -- mv_map groups together all the things imported from a particular module.
	 mv_map, mv_map_mod :: FiniteMap Module [LocalVersion Name]

	 mv_map_mod = foldl add_mod emptyFM export_mods
		-- mv_map_mod records all the modules that have a "module M"
		-- in this module's export list

	 mv_map = foldl add_mv mv_map_mod imp_names
		-- mv_map adds the version numbers of things exported individually
575
    in
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
    returnRn [ (mod, mod_version mod, local_versions)
	     | (mod, local_versions) <- fmToList mv_map
	     ]

  where
     export_mods = case exports of
			Nothing -> []
			Just es -> [mod | IEModuleContents mod <- es, mod /= this_mod]

     add_mv mv_map v@(name, version) 
      = addToFM_C (\ ls _ -> (v:ls)) mv_map mod [v] 
	where
	 (mod,_) = modAndOcc name

     add_mod mv_map mod = addToFM mv_map mod []
591
\end{code}
592

593
594
595
596
597
598
599
600
601
602
603
604
605
%*********************************************************
%*							*
\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@).

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

606
\begin{code}
607
608
609
getDeclBinders :: (RdrName -> SrcLoc -> RnMG Name)		-- New-name function
		-> RdrNameHsDecl
		-> RnMG AvailInfo
610

611
612
613
getDeclBinders new_name (TyD (TyData _ tycon _ condecls _ _ src_loc))
  = new_name tycon src_loc			`thenRn` \ tycon_name ->
    getConFieldNames new_name condecls		`thenRn` \ sub_names ->
614
    returnRn (AvailTC tycon_name (tycon_name : sub_names))
615

616
617
618
getDeclBinders new_name (TyD (TyNew _ tycon _ (NewConDecl con _ con_loc) _ _ src_loc))
  = new_name tycon src_loc		`thenRn` \ tycon_name ->
    new_name con src_loc		`thenRn` \ con_name ->
619
    returnRn (AvailTC tycon_name [tycon_name, con_name])
620

621
622
getDeclBinders new_name (TyD (TySynonym tycon _ _ src_loc))
  = new_name tycon src_loc		`thenRn` \ tycon_name ->
623
    returnRn (Avail tycon_name)
624
625
626
627

getDeclBinders new_name (ClD (ClassDecl _ cname _ sigs _ _ src_loc))
  = new_name cname src_loc			`thenRn` \ class_name ->
    mapRn (getClassOpNames new_name) sigs	`thenRn` \ sub_names ->
628
    returnRn (AvailTC class_name (class_name : sub_names))
629
630
631

getDeclBinders new_name (SigD (IfaceSig var ty prags src_loc))
  = new_name var src_loc			`thenRn` \ var_name ->
632
    returnRn (Avail var_name)
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656

getDeclBinders new_name (DefD _)  = returnRn NotAvailable
getDeclBinders new_name (InstD _) = returnRn NotAvailable

----------------
getConFieldNames new_name (ConDecl con _ src_loc : rest)
  = new_name con src_loc		`thenRn` \ n ->
    getConFieldNames new_name rest	`thenRn` \ ns -> 
    returnRn (n:ns)

getConFieldNames new_name (NewConDecl con _ src_loc : rest)
  = new_name con src_loc		`thenRn` \ n ->
    getConFieldNames new_name rest	`thenRn` \ ns -> 
    returnRn (n:ns)

getConFieldNames new_name (ConOpDecl _ con _ src_loc : rest)
  = new_name con src_loc		`thenRn` \ n ->
    getConFieldNames new_name rest	`thenRn` \ ns -> 
    returnRn (n:ns)

getConFieldNames new_name (RecConDecl con fielddecls src_loc : rest)
  = mapRn (\n -> new_name n src_loc) (con:fields)	`thenRn` \ cfs ->
    getConFieldNames new_name rest			`thenRn` \ ns  -> 
    returnRn (cfs ++ ns)
657
  where
658
659
660
    fields = concat (map fst fielddecls)

getConFieldNames new_name [] = returnRn []
661

662
getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
663
664
665
\end{code}


666
667
668
669
670
671
%*********************************************************
%*							*
\subsection{Reading an interface file}
%*							*
%*********************************************************

672
\begin{code}
673
674
675
676
677
678
679
680
findAndReadIface :: Pretty -> Module -> RnMG (Maybe ParsedIface)
	-- Nothing <=> file not found, or unreadable, or illegible
	-- Just x  <=> successfully found and parsed 
findAndReadIface doc_str mod
  = traceRn trace_msg			`thenRn_`
    getSearchPathRn			`thenRn` \ dirs ->
    try dirs dirs
  where
681
    trace_msg = ppHang (ppBesides [ppPStr SLIT("Reading interface for "), 
682
				   pprModule PprDebug mod, ppSemi])
683
		     4 (ppBesides [ppPStr SLIT("reason: "), doc_str])
684

685
686
687
688
689
690
691
692
    mod_str = moduleString mod
    hisuf =
      if isPreludeModule mod then
         case opt_HiSuffixPrelude of { Just hisuf -> hisuf; _ -> ".hi"}
      else
         case opt_HiSuffix of {Just hisuf -> hisuf; _ -> ".hi"}

    try all_dirs [] = traceRn (ppPStr SLIT("...failed"))	`thenRn_`
693
694
695
696
697
698
		      returnRn Nothing

    try all_dirs (dir:dirs)
	= readIface file_path	`thenRn` \ read_result ->
	  case read_result of
		Nothing    -> try all_dirs dirs
699
		Just iface -> traceRn (ppPStr SLIT("...done"))	`thenRn_`
700
701
			      returnRn (Just iface)
	where
702
	  file_path = dir ++ "/" ++ moduleString mod ++ hisuf
703
\end{code}
704

705
@readIface@ trys just one file.
706

707
708
709
710
711
\begin{code}
readIface :: String -> RnMG (Maybe ParsedIface)	
	-- Nothing <=> file not found, or unreadable, or illegible
	-- Just x  <=> successfully found and parsed 
readIface file_path
712
713
  = ioToRnMG (hGetStringBuffer file_path)  	`thenRn` \ read_result ->
--OLD:  = ioToRnMG (readFile file_path)  	`thenRn` \ read_result ->
714
715
    case read_result of
	Right contents	  -> case parseIface contents of
716
717
718
719
				Failed err      -> --ioToRnMG (freeStringBuffer contents) `thenRn` \ _ -> 
					           failWithRn Nothing err 
				Succeeded iface -> --ioToRnMG (freeStringBuffer contents) `thenRn` \ _ ->
						   returnRn (Just iface)
720

721
	Left  (NoSuchThing _) -> returnRn Nothing
722

723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
	Left  err	      -> failWithRn Nothing
					    (cannaeReadFile file_path err)

\end{code}

mkSearchPath takes a string consisting of a colon-separated list of directories, and turns it into
a list of directories.  For example:

	mkSearchPath "foo:.:baz"  =  ["foo", ".", "baz"]

\begin{code}
mkSearchPath :: Maybe String -> SearchPath
mkSearchPath Nothing = ["."]
mkSearchPath (Just s)
  = go s
  where
    go "" = []
    go s  = first : go (drop 1 rest)
	  where
	    (first,rest) = span (/= ':') s
\end{code}
744

745
746
747
748
749
%*********************************************************
%*							*
\subsection{Errors}
%*							*
%*********************************************************
750

751
752
\begin{code}
noIfaceErr mod sty
753
  = ppBesides [ppPStr SLIT("Could not find valid interface file for "), ppQuote (pprModule sty mod)]
754
--	, ppStr " in"]) 4 (ppAboves (map ppStr dirs))
755

756
cannaeReadFile file err sty
757
758
759
760
761
762
763
  = ppBesides [ppPStr SLIT("Failed in reading file: "), ppStr file, ppPStr SLIT("; error="), ppStr (show err)]

getDeclErr name sty
  = ppSep [ppPStr SLIT("Failed to find interface decl for"), ppr sty name]

getDeclWarn name sty
  = ppSep [ppPStr SLIT("Warning: failed to find (optional) interface decl for"), ppr sty name]
764
\end{code}