RnIfaces.lhs 34.8 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 )
sof's avatar
sof committed
69
import ErrUtils         ( Message )
70
import Lex
sof's avatar
sof committed
71
import Outputable
72
73
74

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

77

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

84
\begin{code}
85
loadHomeInterface :: SDoc -> Name -> RnM d Ifaces
86
loadHomeInterface doc_str name
87
88
89
90
91
92
93
94
95
96
97
  = 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
98

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

	-- 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_`

115
	-- CHECK WHETHER WE HAVE IT ALREADY
116
117
118
119
120
121
   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 ->
122
123

	-- READ THE MODULE IN
124
125
   findAndReadIface doc_str mod_name from in_map
   `thenRn` \ (hi_boot_read, read_result) ->
sof's avatar
sof committed
126
   case read_result of {
127
	Nothing -> 	-- Not found, so add an empty export env to the Ifaces map
128
			-- so that we don't look again
129
130
131
132
133
134
135
	   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) ;
136
137

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

	-- LOAD IT INTO Ifaces
141

sof's avatar
sof committed
142
143
144
145
	-- 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)
146

147
    getModuleRn 		`thenRn` \ this_mod_nm ->
148
    let
149
150
151
152
	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 ->
153
154
155
    (if (opt_IgnoreIfacePragmas) 
	then returnRn emptyBag
	else foldlRn (loadRule mod)  (iRules ifaces) (pi_rules iface))	`thenRn` \ new_rules -> 
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
    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 }
175
    in
176
    setIfacesRn new_ifaces		`thenRn_`
177
    returnRn (mod, new_ifaces)
sof's avatar
sof committed
178
179
    }}

180
181
182
183
184
185
186
187
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
188
	| otherwise  =  addToFM_C combine deps imp_mod (version, has_orphans, Nothing)
189
190
191
192
193
194
195
196
197
	-- 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]
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
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
217
  = mapRn (load_entity mod) entities
218
  where
219
    new_name mod occ = mkImportedGlobalName mod occ
220

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

229

230
loadFixDecl :: ModuleName -> FixityEnv
231
	    -> (Version, RdrNameHsDecl)
232
233
	    -> RnM d FixityEnv
loadFixDecl mod_name fixity_env (version, FixD sig@(FixitySig rdr_name fixity loc))
234
235
236
  = 	-- 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
237
    mkImportedGlobalName mod_name (rdrNameOcc rdr_name) 	`thenRn` \ name ->
238
239
240
241
242
243
    let
	new_fixity_env = addToNameEnv fixity_env name (FixitySig name fixity loc)
    in
    returnRn new_fixity_env

	-- Ignore the other sorts of decl
244
loadFixDecl mod_name fixity_env other_decl = returnRn fixity_env
245

246
247
loadDecl :: Module 
	 -> DeclsMap
248
	 -> (Version, RdrNameHsDecl)
249
	 -> RnM d DeclsMap
250

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

257
258
259
260
    getDeclSysBinders new_name decl	`thenRn` \ sys_bndrs ->
    let
	main_name     = availName avail
	new_decls_map = foldl add_decl decls_map
261
				       [ (name, (version, avail, name==main_name, (mod, decl'))) 
262
263
				       | name <- sys_bndrs ++ availNames avail]
	add_decl decls_map (name, stuff)
264
	  = WARN( name `elemNameEnv` decls_map, ppr name )
265
266
267
	    addToNameEnv decls_map name stuff
    in
    returnRn new_decls_map
268
    }
269
  where
270
271
272
273
274
	-- 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
275
    {-
276
277
      If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
      we toss away unfolding information.
sof's avatar
sof committed
278
279
280
281
282

      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
283
284
      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
285
      just ignore unfolding info.
286
287
288
289

      [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
290
    -}
291
    decl' = case decl of
292
293
294
	       SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas
			 ->  SigD (IfaceSig name tp [] loc)
	       other	 -> decl
sof's avatar
sof committed
295

296
297
loadInstDecl :: Module
	     -> Bag GatedDecl
298
	     -> RdrNameInstDecl
299
300
	     -> RnM d (Bag GatedDecl)
loadInstDecl mod insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
301
302
303
304
305
306
307
308
  = 
	-- 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 ...
309
	--
310
311
	-- Here the gates are Baz and T, but *not* Foo.
    let 
312
313
	munged_inst_ty = removeContext inst_ty
	free_names     = extractHsTyRdrNames munged_inst_ty
314
    in
315
316
317
318
    setModuleRn (moduleName mod) $
    mapRn mkImportedGlobalFromRdrName free_names	`thenRn` \ gate_names ->
    returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)

319
320
321
322
323
324
325
326
327
328
329
330

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


331
332
333
334
335
336
337
338
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)
339
\end{code}
340

341

342
343
344
345
346
347
348
%********************************************************
%*							*
\subsection{Loading usage information}
%*							*
%********************************************************

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

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

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

370
checkModUsage [] = returnRn True		-- Yes!  Everything is up to date!
371

372
373
checkModUsage ((mod_name, old_mod_vers, _, whats_imported) : rest)
  = loadInterface doc_str mod_name ImportBySystem	`thenRn` \ (mod, ifaces) ->
374
    let
375
376
377
	maybe_mod_vers = case lookupFM (iImpModInfo ifaces) mod_name of
			   Just (version, _, Just (_, _, _)) -> Just version
			   other			     -> Nothing
378
    in
379
380
381
382
    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"), 
383
384
			      pprModuleName mod_name])
		`thenRn_` returnRn False ;
385
386

	Just new_mod_vers ->
387
388
389

	-- If the module version hasn't changed, just move on
    if new_mod_vers == old_mod_vers then
390
391
	traceRn (sep [ptext SLIT("Module version unchanged:"), pprModuleName mod_name])
	`thenRn_` checkModUsage rest
392
    else
393
394
    traceRn (sep [ptext SLIT("Module version has changed:"), pprModuleName mod_name])
    `thenRn_`
395
396
397
398
399
400
401
402
403
404
	-- 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 ->
405

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


418
checkEntityUsage mod decls [] 
419
420
  = returnRn True	-- Yes!  All up to date!

421
checkEntityUsage mod decls ((occ_name,old_vers) : rest)
422
  = mkImportedGlobalName mod occ_name 	`thenRn` \ name ->
423
    case lookupNameEnv decls name of
424
425

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

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

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


441
442
443
444
445
%*********************************************************
%*							*
\subsection{Getting in a declaration}
%*							*
%*********************************************************
446

447
\begin{code}
448
449
450
451
452
453
454
455
456
457
458
459
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
460
461
	returnRn Nothing	-- Already dealt with
    else
462
	if isLocallyDefined name then	-- Don't bring in decls from
463
					-- the renamed module's own interface file
464
		  addWarnRn (importDeclWarn name) `thenRn_`
465
466
467
		  returnRn Nothing
	else
	getNonWiredInDecl name
468
\end{code}
469

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

477
478
      Just (version,avail,_,decl)
	-> recordSlurp (Just version) avail	`thenRn_`
479
	   returnRn (Just decl)
480

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

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

496
\item 	similarly for synonum type constructor
497

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

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


509
    
510
511
%*********************************************************
%*							*
sof's avatar
sof committed
512
\subsection{Getting what a module exports}
513
514
%*							*
%*********************************************************
515

516
@getInterfaceExports@ is called only for directly-imported modules.
517

518
\begin{code}
519
520
521
522
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
523
524
525
526
527
	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, [])
528

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


%*********************************************************
%*							*
537
\subsection{Instance declarations are handled specially}
sof's avatar
sof committed
538
539
540
541
%*							*
%*********************************************************

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

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

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

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

576
577
578
579
580
ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
  = case inst_ty of
	HsForAllTy _ _ tau -> ppr tau
	other		   -> ppr inst_ty

581
getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
582
583
584
getImportedRules 
  | opt_IgnoreIfacePragmas = returnRn []
  | otherwise
585
586
587
588
589
590
591
592
593
  = 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
594

595
selectGated gates decl_bag
596
	-- Select only those decls whose gates are *all* in 'gates'
597
598
599
#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
600

601
602
603
  | otherwise
#endif
  = foldrBag select ([], emptyBag) decl_bag
604
  where
605
606
607
608
609
610
611
612
613
614
615
616
617
    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
618
  = loadHomeInterface doc name		`thenRn` \ ifaces ->
619
620
621
    case lookupNameEnv (iFixes ifaces) name of
	Just (FixitySig _ fix _) -> returnRn fix 
	Nothing 		 -> returnRn defaultFixity
622
  where
623
    doc = ptext SLIT("Checking fixity for") <+> ppr name
624
625
\end{code}

sof's avatar
sof committed
626
627
628
629
630
631
632

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

633
634
getImportVersions figures out
what the ``usage information'' for this moudule is;
635
636
that is, what it must record in its interface file as the things it uses.
It records:
637
638
639
640
641
642
\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
643
644
645
646
647
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? 
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
\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@
666
(and this usage-version info isn't used by any importer).
667
668
669
670
671
672
673
674
675
676

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.
677

678
\begin{code}
679
getImportVersions :: ModuleName			-- Name of this module
680
		  -> Maybe [IE any]		-- Export list for this module
681
		  -> RnMG (VersionInfo Name)	-- Version info for these names
682

683
getImportVersions this_mod exports
684
685
  = getIfacesRn					`thenRn` \ ifaces ->
    let
686
687
	mod_map   = iImpModInfo ifaces
	imp_names = iVSlurp     ifaces
688

689
	-- mv_map groups together all the things imported from a particular module.
690
	mv_map1, mv_map2 :: FiniteMap ModuleName (WhatsImported Name)
691

692
		-- mv_map1 records all the modules that have a "module M"
693
		-- in this module's export list with an "Everything" 
694
695
696
697
698
	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

699
700
701
702
703
704
	-- 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.
705
	mk_version_info mod_name (version, has_orphans, cts) so_far
706
707
708
709
710
711
712
713
714
	   | 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
715
716
717
718
719
	   where
	     whats_imported = case lookupFM mv_map2 mod_name of
				Just wi -> wi
				Nothing -> Specifically []

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

730
     add_mv v@(name, version) mv_map
731
      = addToFM_C add_item mv_map mod (Specifically [v]) 
732
	where
733
	 mod = moduleName (nameModule name)
734

735
736
737
         add_item Everything        _ = Everything
         add_item (Specifically xs) _ = Specifically (v:xs)

738
     add_mod mod mv_map = addToFM mv_map mod Everything
739
\end{code}
740

sof's avatar
sof committed
741
\begin{code}
742
getSlurped
sof's avatar
sof committed
743
  = getIfacesRn 	`thenRn` \ ifaces ->
744
    returnRn (iSlurp ifaces)
sof's avatar
sof committed
745

746
747
748
recordSlurp maybe_version avail
  = getIfacesRn 	`thenRn` \ ifaces@(Ifaces { iSlurp  = slurped_names,
					            iVSlurp = imp_names }) ->
sof's avatar
sof committed
749
750
751
752
    let
	new_slurped_names = addAvailToNameSet slurped_names avail

	new_imp_names = case maybe_version of
sof's avatar
sof committed
753
			   Just version	-> (availName avail, version) : imp_names
sof's avatar
sof committed
754
755
			   Nothing      -> imp_names
    in
756
757
    setIfacesRn (ifaces { iSlurp  = new_slurped_names,
			  iVSlurp = new_imp_names })
sof's avatar
sof committed
758
759
760
\end{code}


761
762
763
764
765
766
767
768
769
770
%*********************************************************
%*							*
\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@).

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

774
\begin{code}
775
getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name)	-- New-name function
776
		-> RdrNameHsDecl
777
		-> RnM d (Maybe AvailInfo)
778

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

786
getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
787
  = new_name tycon src_loc		`thenRn` \ tycon_name ->
788
    returnRn (Just (AvailTC tycon_name [tycon_name]))
789

790
getDeclBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ _ _ _ src_loc))
791
  = new_name cname src_loc			`thenRn` \ class_name ->
792
793

	-- Record the names for the class ops
sof's avatar
sof committed
794
    let
sof's avatar
sof committed
795
796
	-- just want class-op sigs
	op_sigs = filter isClassOpSig sigs
sof's avatar
sof committed
797
    in
sof's avatar
sof committed
798
    mapRn (getClassOpNames new_name) op_sigs	`thenRn` \ sub_names ->
799

800
    returnRn (Just (AvailTC class_name (class_name : sub_names)))
801
802
803

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

806
getDeclBinders new_name (FixD _)  = returnRn Nothing
sof's avatar
sof committed
807
808
809
810
811
812
813
814
815
816
817

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

818
819
getDeclBinders new_name (DefD _)  = returnRn Nothing
getDeclBinders new_name (InstD _) = returnRn Nothing
820
getDeclBinders new_name (RuleD _) = returnRn Nothing
821

sof's avatar
sof committed
822
823
824
825
binds_haskell_name (FoImport _) _   = True
binds_haskell_name FoLabel      _   = True
binds_haskell_name FoExport  ext_nm = isDynamic ext_nm

826
----------------
827
getConFieldNames new_name (ConDecl con _ _ (RecCon fielddecls) src_loc : rest)
828
829
830
  = mapRn (\n -> new_name n src_loc) (con:fields)	`thenRn` \ cfs ->
    getConFieldNames new_name rest			`thenRn` \ ns  -> 
    returnRn (cfs ++ ns)
831
  where
832
833
    fields = concat (map fst fielddecls)

sof's avatar
sof committed
834
getConFieldNames new_name (ConDecl con _ _ condecl src_loc : rest)
sof's avatar
sof committed
835
  = new_name con src_loc		`thenRn` \ n ->
sof's avatar
sof committed
836
837
838
839
840
    (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
841
    getConFieldNames new_name rest	`thenRn` \ ns -> 
sof's avatar
sof committed
842
    returnRn (nn ++ ns)
sof's avatar
sof committed
843

844
getConFieldNames new_name [] = returnRn []
845

846
getClassOpNames new_name (ClassOpSig op _ _ _ src_loc) = new_name op src_loc
847
848
\end{code}

849
850
@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.
851
852
They aren't returned by @getDeclBinders@ because they aren't in scope;
but they {\em should} be put into the @DeclsMap@ of this module.
853

854
855
856
857
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.

858
\begin{code}
859
getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ tname dname snames src_loc))
860
861
862
863
  = 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)
864
865
866
867

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

869
870
871
872
873
874
%*********************************************************
%*							*
\subsection{Reading an interface file}
%*							*
%*********************************************************

875
\begin{code}
876
877
878
879
880
881
882
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
883
884
	-- Nothing <=> file not found, or unreadable, or illegible
	-- Just x  <=> successfully found and parsed 
885

886
findAndReadIface doc_str mod_name from hi_file
887
  = traceRn trace_msg			`thenRn_`
888
889
890
      -- 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.
891
892
893
894

    getHiMaps			`thenRn` \ hi_maps ->
	
    case find_path from hi_maps of
895
         -- Found the file
896
897
       (hi_boot, Just (fpath, mod)) -> traceRn (ptext SLIT("...reading from") <+> text fpath)
				       `thenRn_`
898
899
900
901
				       readIface mod fpath	`thenRn` \ result ->
				       returnRn (hi_boot, result)
       (hi_boot, Nothing)           -> traceRn (ptext SLIT("...not found"))	`thenRn_`
				       returnRn (hi_boot, Nothing)
902
  where
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
    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
918

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

sof's avatar
sof committed
926
@readIface@ tries just the one file.
927

928
\begin{code}
929
readIface :: Module -> String -> RnM d (Maybe (Module, ParsedIface))
930
931
	-- Nothing <=> file not found, or unreadable, or illegible
	-- Just x  <=> successfully found and parsed 
932
readIface the_mod file_path
933
  = ioToRnM (hGetStringBuffer False file_path)       `thenRn` \ read_result ->
934
    case read_result of
sof's avatar
sof committed
935
	Right contents	  -> 
936
937
938
939
940
941
942
             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) ->
943
		    warnCheckRn (mod_nm == moduleName the_mod)
sof's avatar
sof committed
944
945
		    	        (hiModuleNameMismatchWarn the_mod mod_nm) `thenRn_`
		    returnRn (Just (the_mod, iface))
sof's avatar
sof committed
946
947
948
949

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

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

958
\begin{code}
959
960
961
962
963
964
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
965

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

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

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

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

987
warnRedundantSourceImport mod_name
988
989
  = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
          <+> quotes (pprModuleName mod_name)
sof's avatar
sof committed
990
991
992
993
994
995
996
997
998

hiModuleNameMismatchWarn :: Module -> ModuleName -> Message
hiModuleNameMismatchWarn requested_mod mod_nm = 
    hsep [ ptext SLIT("Something is amiss; requested module name")
	 , pprModule requested_mod
	 , ptext SLIT("differs from name found in the interface file ")
   	 , pprModuleName mod_nm
  	 ]

999
\end{code}