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

\begin{code}
7
8
module RnIfaces
       (
9
 	findAndReadIface, 
10

11
	getInterfaceExports,
12
	getImportedInstDecls, getImportedRules,
13
	lookupFixityRn, loadHomeInterface,
14
15
	importDecl, ImportDeclResult(..), recordLocalSlurps, 
	mkImportInfo, getSlurped, 
16

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

22
#include "HsVersions.h"
23

24
import CmdLineOpts	( opt_NoPruneDecls, opt_NoPruneTyDecls, opt_IgnoreIfacePragmas )
25
import HscTypes
26
import HsSyn		( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), 
27
			  HsType(..), ConDecl(..), 
28
			  ForeignDecl(..), ForKind(..), isDynamicExtName,
29
			  FixitySig(..), RuleDecl(..),
30
			  tyClDeclNames
31
			)
32
import HsImpExp		( ImportDecl(..) )
33
import BasicTypes	( Version, defaultFixity )
34
import RdrHsSyn		( RdrNameHsDecl, RdrNameInstDecl, RdrNameRuleDecl,
35
			  extractHsTyRdrNames 
36
			)
37
import RnEnv
38
import RnMonad
39
import ParseIface	( parseIface, IfaceStuff(..) )
40

41
42
import Name		( Name {-instance NamedThing-}, nameOccName,
			  nameModule, isLocallyDefined, 
43
44
			  NamedThing(..),
			  mkNameEnv, elemNameEnv, extendNameEnv
45
			 )
46
import Module		( Module, ModuleEnv,
47
			  moduleName, isModuleInThisPackage,
48
			  ModuleName, WhereFrom(..),
49
			  emptyModuleEnv, extendModuleEnv, lookupModuleEnvByName,
50
			  extendModuleEnv_C, lookupWithDefaultModuleEnv
51
52
			)
import RdrName		( RdrName, rdrNameOcc )
53
import NameSet
54
import SrcLoc		( mkSrcLoc, SrcLoc )
55
import PrelInfo		( wiredInThingEnv )
56
import Maybes		( maybeToBool, orElse )
57
import StringBuffer     ( hGetStringBuffer )
58
import FastString	( mkFastString )
sof's avatar
sof committed
59
import ErrUtils         ( Message )
60
import Lex
61
import FiniteMap
sof's avatar
sof committed
62
import Outputable
63
import Bag
64

65
import List		( nub )
66
67
\end{code}

68

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

75
\begin{code}
76
loadHomeInterface :: SDoc -> Name -> RnM d Ifaces
77
loadHomeInterface doc_str name
78
  = loadInterface doc_str (moduleName (nameModule name)) ImportBySystem
79
80
81
82

loadOrphanModules :: [ModuleName] -> RnM d ()
loadOrphanModules mods
  | null mods = returnRn ()
83
  | otherwise = traceRn (text "Loading orphan modules:" <+> 
84
			 fsep (map ppr mods))			`thenRn_` 
85
		mapRn_ load mods				`thenRn_`
86
87
		returnRn ()
  where
88
    load mod   = loadInterface (mk_doc mod) mod ImportBySystem
89
    mk_doc mod = ppr mod <+> ptext SLIT("is a orphan-instance module")
90
	   
91

92
93
94
95
96
97
98
99
100
101
102
103
loadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d Ifaces
loadInterface doc mod from 
  = tryLoadInterface doc mod from	`thenRn` \ (ifaces, maybe_err) ->
    case maybe_err of
	Nothing  -> returnRn ifaces
	Just err -> failWithRn ifaces err

tryLoadInterface :: SDoc -> ModuleName -> WhereFrom -> RnM d (Ifaces, Maybe Message)
	-- Returns (Just err) if an error happened
	-- Guarantees to return with iImpModInfo m --> (... Just cts)
	-- (If the load fails, we plug in a vanilla placeholder
tryLoadInterface doc_str mod_name from
104
 = getIfacesRn 			`thenRn` \ ifaces ->
sof's avatar
sof committed
105
   let
106
107
108
	mod_map  = iImpModInfo ifaces
	mod_info = lookupFM mod_map mod_name

109
110
111
112
113
114
115
116
117
118
119
	hi_boot_file 
	  = case (from, mod_info) of
		(ImportByUser,       _)    	       -> False 	-- Not hi-boot
		(ImportByUserSource, _)		       -> True 		-- hi-boot
		(ImportBySystem, Just (_, is_boot, _)) -> is_boot 	-- 
		(ImportBySystem, Nothing)	       -> False
			-- We're importing a module we know absolutely
			-- nothing about, so we assume it's from
			-- another package, where we aren't doing 
			-- dependency tracking. So it won't be a hi-boot file.

120
121
	redundant_source_import 
	  = case (from, mod_info) of 
122
		(ImportByUserSource, Just (_,False,_)) -> True
123
		other				       -> False
124
   in
125
	-- CHECK WHETHER WE HAVE IT ALREADY
126
   case mod_info of {
127
	Just (_, _, True)
128
		-> 	-- We're read it already so don't re-read it
129
		    returnRn (ifaces, Nothing) ;
130

131
132
133
134
135
136
137
	_ ->

	-- Issue a warning for a redundant {- SOURCE -} import
	-- NB that we arrange to read all the ordinary imports before 
	-- any of the {- SOURCE -} imports
   warnCheckRn	(not redundant_source_import)
		(warnRedundantSourceImport mod_name)	`thenRn_`
138
139

	-- READ THE MODULE IN
140
   findAndReadIface doc_str mod_name hi_boot_file   `thenRn` \ read_result ->
sof's avatar
sof committed
141
   case read_result of {
142
	Left err -> 	-- Not found, so add an empty export env to the Ifaces map
143
			-- so that we don't look again
144
	   let
145
		new_mod_map = addToFM mod_map mod_name (False, False, True)
146
147
148
		new_ifaces  = ifaces { iImpModInfo = new_mod_map }
	   in
	   setIfacesRn new_ifaces		`thenRn_`
149
	   returnRn (new_ifaces, Just err) ;
150
151

	-- Found and parsed!
152
	Right (mod, iface) ->
153
154

	-- LOAD IT INTO Ifaces
155

sof's avatar
sof committed
156
157
158
159
	-- 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)
160

161

162
163
164
165
	-- Sanity check.  If we're system-importing a module we know nothing at all
	-- about, it should be from a different package to this one
    WARN( not (maybeToBool mod_info) && 
	  case from of { ImportBySystem -> True; other -> False } &&
166
	  isModuleInThisPackage mod,
167
	  ppr mod )
168
169
170

    loadDecls mod		(iDecls ifaces)	  (pi_decls iface)	`thenRn` \ (decls_vers, new_decls) ->
    loadRules mod		(iRules ifaces)   (pi_rules iface)	`thenRn` \ (rule_vers, new_rules) ->
171
172
    loadFixDecls mod_name	 		  (pi_fixity iface)	`thenRn` \ fix_env ->
    loadDeprecs mod				  (pi_deprecs iface)	`thenRn` \ deprec_env ->
173
    foldlRn (loadInstDecl mod)	(iInsts ifaces)   (pi_insts iface)	`thenRn` \ new_insts ->
174
    loadExports 			 	  (pi_exports iface)	`thenRn` \ (export_vers, avails) ->
175
    let
176
	version	= VersionInfo { vers_module  = pi_vers iface, 
177
				vers_exports = export_vers,
178
179
				vers_rules = rule_vers,
				vers_decls = decls_vers }
180

181
182
183
184
	-- 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
185
			ImportByUser -> addModDeps mod (pi_usages iface) mod_map
186
			other        -> mod_map
187
188
189
190
191
192
193
194
195
196
197
198
	mod_map2 = addToFM mod_map1 mod_name (has_orphans, hi_boot_file, True)

	-- Now add info about this module to the PIT
	has_orphans = pi_orphan iface
	new_pit   = extendModuleEnv (iPIT ifaces) mod mod_iface
 	mod_iface = ModIface { mi_module = mod, mi_version = version,
			       mi_exports = avails, mi_orphan = has_orphans,
			       mi_fixities = fix_env, mi_deprecs = deprec_env,
			       mi_usages  = [],	-- Will be filled in later
			       mi_decls   = panic "No mi_decls in PIT",
			       mi_globals = panic "No mi_globals in PIT"
		    }
199

200
	new_ifaces = ifaces { iPIT	  = new_pit,
201
			      iDecls      = new_decls,
202
			      iInsts      = new_insts,
203
			      iRules	  = new_rules,
204
			      iImpModInfo = mod_map2  }
205
    in
206
    setIfacesRn new_ifaces		`thenRn_`
207
    returnRn (new_ifaces, Nothing)
sof's avatar
sof committed
208
209
    }}

210
211
212
213
214
-----------------------------------------------------
--	Adding module dependencies from the 
--	import decls in the interface file
-----------------------------------------------------

215
addModDeps :: Module -> [ImportVersion a] 
216
217
218
219
220
	   -> ImportedModuleInfo -> ImportedModuleInfo
-- (addModDeps M ivs deps)
-- We are importing module M, and M.hi contains 'import' decls given by ivs
addModDeps mod new_deps mod_deps
  = foldr add mod_deps filtered_new_deps
221
  where
222
223
224
	-- Don't record dependencies when importing a module from another package
	-- Except for its descendents which contain orphans,
	-- and in that case, forget about the boot indicator
225
    filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface, IsLoaded))]
226
    filtered_new_deps
227
228
	| isModuleInThisPackage mod 
			    = [ (imp_mod, (has_orphans, is_boot, False))
229
			      | (imp_mod, has_orphans, is_boot, _) <- new_deps 
230
			      ]			      
231
	| otherwise	    = [ (imp_mod, (True, False, False))
232
			      | (imp_mod, has_orphans, _, _) <- new_deps, 
233
234
235
				has_orphans
			      ]
    add (imp_mod, dep) deps = addToFM_C combine deps imp_mod dep
236

237
238
    combine old@(_, old_is_boot, old_is_loaded) new
	| old_is_loaded || not old_is_boot = old	-- Keep the old info if it's already loaded
239
							-- or if it's a non-boot pending load
240
	| otherwise			    = new	-- Otherwise pick new info
241

242
243
244
245
246

-----------------------------------------------------
--	Loading the export list
-----------------------------------------------------

247
248
loadExports :: (Version, [ExportItem]) -> RnM d (Version, Avails)
loadExports (vers, items)
249
250
  = getModuleRn 				`thenRn` \ this_mod ->
    mapRn (loadExport this_mod) items		`thenRn` \ avails_s ->
251
    returnRn (vers, concat avails_s)
252
253


254
loadExport :: Module -> ExportItem -> RnM d [AvailInfo]
255
loadExport this_mod (mod, entities)
256
  | mod == moduleName this_mod = returnRn []
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
	-- 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
274
  = mapRn (load_entity mod) entities
275
  where
276
    new_name mod occ = newGlobalName mod occ
277

sof's avatar
sof committed
278
279
    load_entity mod (Avail occ)
      =	new_name mod occ	`thenRn` \ name ->
sof's avatar
sof committed
280
	returnRn (Avail name)
sof's avatar
sof committed
281
282
283
    load_entity mod (AvailTC occ occs)
      =	new_name mod occ	      `thenRn` \ name ->
        mapRn (new_name mod) occs     `thenRn` \ names ->
sof's avatar
sof committed
284
        returnRn (AvailTC name names)
285

286

287
288
289
-----------------------------------------------------
--	Loading type/class/value decls
-----------------------------------------------------
290

291
292
293
294
295
296
297
loadDecls :: Module 
	  -> DeclsMap
	  -> [(Version, RdrNameHsDecl)]
	  -> RnM d (NameEnv Version, DeclsMap)
loadDecls mod decls_map decls
  = foldlRn (loadDecl mod) (emptyNameEnv, decls_map) decls

298
loadDecl :: Module 
299
	 -> (NameEnv Version, DeclsMap)
300
	 -> (Version, RdrNameHsDecl)
301
302
	 -> RnM d (NameEnv Version, DeclsMap)
loadDecl mod (version_map, decls_map) (version, decl)
303
304
  = getDeclBinders new_name decl	`thenRn` \ maybe_avail ->
    case maybe_avail of {
305
306
	Nothing    -> returnRn (version_map, decls_map);	-- No bindings
	Just avail -> 
307

308
309
    getDeclSysBinders new_name decl	`thenRn` \ sys_bndrs ->
    let
310
311
312
313
314
	full_avail    = addSysAvails avail sys_bndrs
		-- Add the sys-binders to avail.  When we import the decl,
		-- it's full_avail that will get added to the 'already-slurped' set (iSlurp)
		-- If we miss out sys-binders, we'll read the decl multiple times!

315
316
	main_name     = availName avail
	new_decls_map = foldl add_decl decls_map
317
				       [ (name, (full_avail, name==main_name, (mod, decl'))) 
318
				       | name <- availNames full_avail]
319
	add_decl decls_map (name, stuff)
320
	  = WARN( name `elemNameEnv` decls_map, ppr name )
321
	    extendNameEnv decls_map name stuff
322
323

	new_version_map = extendNameEnv version_map main_name version
324
    in
325
    returnRn (new_version_map, new_decls_map)
326
    }
327
  where
328
	-- newTopBinder puts into the cache the binder with the
329
330
	-- module information set correctly.  When the decl is later renamed,
	-- the binding site will thereby get the correct module.
331
332
333
	-- There maybe occurrences that don't have the correct Module, but
	-- by the typechecker will propagate the binding definition to all 
	-- the occurrences, so that doesn't matter
334
    new_name rdr_name loc = newTopBinder mod rdr_name loc
335

sof's avatar
sof committed
336
    {-
337
338
      If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
      we toss away unfolding information.
sof's avatar
sof committed
339
340
341
342
343

      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
344
345
      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
346
      just ignore unfolding info.
347
348
349
350

      [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
351
    -}
352
    decl' = case decl of
353
354
355
	       SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas
			 ->  SigD (IfaceSig name tp [] loc)
	       other	 -> decl
sof's avatar
sof committed
356

357
358
359
360
-----------------------------------------------------
--	Loading fixity decls
-----------------------------------------------------

361
loadFixDecls mod_name decls
362
  = mapRn (loadFixDecl mod_name) decls	`thenRn` \ to_add ->
363
    returnRn (mkNameEnv to_add)
364
365

loadFixDecl mod_name sig@(FixitySig rdr_name fixity loc)
366
  = newGlobalName mod_name (rdrNameOcc rdr_name) 	`thenRn` \ name ->
367
    returnRn (name, fixity)
368
369
370
371
372
373


-----------------------------------------------------
--	Loading instance decls
-----------------------------------------------------

374
loadInstDecl :: Module
375
	     -> IfaceInsts
376
	     -> RdrNameInstDecl
377
	     -> RnM d IfaceInsts
378
loadInstDecl mod insts decl@(InstDecl inst_ty binds uprags dfun_name src_loc)
379
380
381
382
383
384
385
386
  = 
	-- 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 ...
387
	--
388
389
	-- Here the gates are Baz and T, but *not* Foo.
    let 
390
391
	munged_inst_ty = removeContext inst_ty
	free_names     = extractHsTyRdrNames munged_inst_ty
392
    in
393
394
    setModuleRn mod $
    mapRn lookupOrigName free_names	`thenRn` \ gate_names ->
395
396
    returnRn ((mkNameSet gate_names, (mod, InstD decl)) `consBag` insts)

397
398
399
400
401
402
403
404

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

405
removeFuns (HsFunTy _ ty) = removeFuns ty
406
407
408
removeFuns ty		    = ty


409
410
411
412
413
414
-----------------------------------------------------
--	Loading Rules
-----------------------------------------------------

loadRules :: Module -> IfaceRules 
	  -> (Version, [RdrNameRuleDecl])
415
	  -> RnM d (Version, IfaceRules)
416
417
loadRules mod rule_bag (version, rules)
  | null rules || opt_IgnoreIfacePragmas 
418
  = returnRn (version, rule_bag)
419
  | otherwise
420
  = setModuleRn mod		 	$
421
    mapRn (loadRule mod) rules		`thenRn` \ new_rules ->
422
    returnRn (version, rule_bag `unionBags` listToBag new_rules)
423
424

loadRule :: Module -> RdrNameRuleDecl -> RnM d GatedDecl
425
426
-- "Gate" the rule simply by whether the rule variable is
-- needed.  We can refine this later.
427
loadRule mod decl@(IfaceRule _ _ var _ _ src_loc)
428
  = lookupOrigName var		`thenRn` \ var_name ->
429
430
431
432
433
434
    returnRn (unitNameSet var_name, (mod, RuleD decl))


-----------------------------------------------------
--	Loading Deprecations
-----------------------------------------------------
435

436
437
438
439
440
441
442
443
444
445
loadDeprecs :: Module -> IfaceDeprecs -> RnM d Deprecations
loadDeprecs m Nothing				       = returnRn NoDeprecs
loadDeprecs m (Just (Left txt)) = returnRn (DeprecAll txt)
loadDeprecs m (Just (Right prs)) = setModuleRn m 				$
    				   foldlRn loadDeprec emptyNameEnv prs	`thenRn` \ env ->
				   returnRn (DeprecSome env)
loadDeprec deprec_env (n, txt)
  = lookupOrigName n 		`thenRn` \ name ->
    traceRn (text "Loaded deprecation(s) for" <+> ppr name <> colon <+> ppr txt) `thenRn_`
    returnRn (extendNameEnv deprec_env name txt)
446
\end{code}
447

448

449
450
451
452
453
%*********************************************************
%*							*
\subsection{Getting in a declaration}
%*							*
%*********************************************************
454

455
\begin{code}
456
457
458
459
460
461
462
importDecl :: Name -> RnMG ImportDeclResult

data ImportDeclResult
  = AlreadySlurped
  | WiredIn	
  | Deferred
  | HereItIs (Module, RdrNameHsDecl)
463
464

importDecl name
465
466
467
468
469
470
471
472
473
  = 	-- Check if it was loaded before beginning this module
    checkAlreadyAvailable name		`thenRn` \ done ->
    if done then
	returnRn AlreadySlurped
    else

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

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

484
485
486
	-- When we find a wired-in name we must load its home
	-- module so that we find any instance decls lurking therein
    if name `elemNameEnv` wiredInThingEnv then
487
488
489
490
491
492
493
494
	loadHomeInterface doc name	`thenRn_`
	returnRn WiredIn

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

getNonWiredInDecl :: Name -> RnMG ImportDeclResult
495
getNonWiredInDecl needed_name 
496
  = traceRn doc_str				`thenRn_`
497
    loadHomeInterface doc_str needed_name	`thenRn` \ ifaces ->
498
    case lookupNameEnv (iDecls ifaces) needed_name of
sof's avatar
sof committed
499

500
{- 		OMIT DEFERRED STUFF FOR NOW, TILL GHCI WORKS
501
      Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _ _)))
502
503
504
505
506
507
508
509
510
511
512
513
514
515
	-- This case deals with deferred import of algebraic data types

	|  not opt_NoPruneTyDecls

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

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

516
517
518
519

	->  	-- OK, so we're importing a deferrable data type
	    if needed_name == tycon_name
	 	-- The needed_name is the TyCon of a data type decl
520
521
522
523
524
525
		-- Record that it's slurped, put it in the deferred set
		-- and don't return a declaration at all
		setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces 
							      `addOneToNameSet` tycon_name})
				    	 version (AvailTC needed_name [needed_name]))	`thenRn_`
		returnRn Deferred
526

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

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

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

549
{-		OMIT FOR NOW
550
551
552
553
554
555
556
557
558
559
560
getDeferredDecls :: RnMG [(Module, RdrNameHsDecl)]
getDeferredDecls 
  = getIfacesRn		`thenRn` \ ifaces ->
    let
	decls_map   	    = iDecls ifaces
	deferred_names	    = nameSetToList (iDeferred ifaces)
        get_abstract_decl n = case lookupNameEnv decls_map n of
				 Just (_, _, _, decl) -> decl
    in
    traceRn (sep [text "getDeferredDecls", nest 4 (fsep (map ppr deferred_names))])	`thenRn_`
    returnRn (map get_abstract_decl deferred_names)
561
-}
562
563
\end{code}

564
565
566
@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,
567
568
\begin{itemize}
\item	if the wired-in name is a data type constructor or a data constructor, 
569
	it brings in the type constructor and all the data constructors; and
570
	marks as ``occurrences'' any free vars of the data con.
571

572
\item 	similarly for synonum type constructor
573

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

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


585
    
586
587
%*********************************************************
%*							*
sof's avatar
sof committed
588
\subsection{Getting what a module exports}
589
590
%*							*
%*********************************************************
591

592
@getInterfaceExports@ is called only for directly-imported modules.
593

594
\begin{code}
595
596
getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, Avails)
getInterfaceExports mod_name from
597
598
599
600
601
602
603
604
605
606
607
  = getHomeIfaceTableRn 		`thenRn` \ hit ->
    case lookupModuleEnvByName hit mod_name of {
	Just mi -> returnRn (mi_module mi, mi_exports mi) ;
        Nothing  -> 

    loadInterface doc_str mod_name from	`thenRn` \ ifaces ->
    case lookupModuleEnvByName (iPIT ifaces) mod_name of
	Just mi -> returnRn (mi_module mi, mi_exports mi) ;
		-- loadInterface always puts something in the map
		-- even if it's a fake
	Nothing -> pprPanic "getInterfaceExports" (ppr mod_name)
608
609
    }
    where
610
      doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")]
sof's avatar
sof committed
611
612
613
614
615
\end{code}


%*********************************************************
%*							*
616
\subsection{Instance declarations are handled specially}
sof's avatar
sof committed
617
618
619
620
%*							*
%*********************************************************

\begin{code}
621
622
getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
getImportedInstDecls gates
623
  =    	-- First, load any orphan-instance modules that aren't aready loaded
624
	-- Orphan-instance modules are recorded in the module dependecnies
625
    getIfacesRn 					`thenRn` \ ifaces ->
sof's avatar
sof committed
626
    let
627
	orphan_mods =
628
	  [mod | (mod, (True, _, False)) <- fmToList (iImpModInfo ifaces)]
sof's avatar
sof committed
629
    in
630
    loadOrphanModules orphan_mods			`thenRn_` 
631

632
	-- Now we're ready to grab the instance declarations
633
634
	-- Find the un-gated ones and return them, 
	-- removing them from the bag kept in Ifaces
635
    getIfacesRn 					`thenRn` \ ifaces ->
636
    let
637
638
639
	(decls, new_insts) = selectGated gates (iInsts ifaces)
    in
    setIfacesRn (ifaces { iInsts = new_insts })		`thenRn_`
640

641
    traceRn (sep [text "getImportedInstDecls:", 
642
		  nest 4 (fsep (map ppr gate_list)),
643
644
		  text "Slurped" <+> int (length decls) <+> text "instance declarations",
		  nest 4 (vcat (map ppr_brief_inst_decl decls))])	`thenRn_`
645
646
    returnRn decls
  where
647
648
    gate_list      = nameSetToList gates

649
650
651
652
653
ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
  = case inst_ty of
	HsForAllTy _ _ tau -> ppr tau
	other		   -> ppr inst_ty

654
getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
655
656
657
getImportedRules 
  | opt_IgnoreIfacePragmas = returnRn []
  | otherwise
658
659
660
  = getIfacesRn 	`thenRn` \ ifaces ->
    let
	gates		   = iSlurp ifaces	-- Anything at all that's been slurped
661
662
	rules		   = iRules ifaces
	(decls, new_rules) = selectGated gates rules
663
    in
664
665
666
667
    if null decls then
	returnRn []
    else
    setIfacesRn (ifaces { iRules = new_rules })		     `thenRn_`
668
    traceRn (sep [text "getImportedRules:", 
669
		  text "Slurped" <+> int (length decls) <+> text "rules"])   `thenRn_`
670
    returnRn decls
671

672
selectGated gates decl_bag
673
	-- Select only those decls whose gates are *all* in 'gates'
674
675
676
#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
677

678
679
680
  | otherwise
#endif
  = foldrBag select ([], emptyBag) decl_bag
681
  where
682
683
684
685
    select (reqd, decl) (yes, no)
	| isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
	| otherwise				     = (yes,      (reqd,decl) `consBag` no)

686
687
lookupFixityRn :: Name -> RnMS Fixity
lookupFixityRn name
688
689
  | isLocallyDefined name
  = getFixityEnv			`thenRn` \ local_fix_env ->
690
    returnRn (lookupLocalFixity local_fix_env name)
691
692

  | otherwise	-- Imported
693
694
695
696
697
698
699
      -- For imported names, we have to get their fixities by doing a loadHomeInterface,
      -- and consulting the Ifaces that comes back from that, because the interface
      -- file for the Name might not have been loaded yet.  Why not?  Suppose you import module A,
      -- which exports a function 'f', which is defined in module B.  Then B isn't loaded
      -- right away (after all, it's possible that nothing from B will be used).
      -- When we come across a use of 'f', we need to know its fixity, and it's then,
      -- and only then, that we load B.hi.  That is what's happening here.
700
  = getHomeIfaceTableRn 		`thenRn` \ hst ->
701
702
703
704
705
    case lookupFixityEnv hst name of {
	Just fixity -> returnRn fixity ;
	Nothing	    -> 

    loadHomeInterface doc name		`thenRn` \ ifaces ->
706
    returnRn (lookupFixityEnv (iPIT ifaces) name `orElse` defaultFixity) 
707
    }
708
  where
709
    doc = ptext SLIT("Checking fixity for") <+> ppr name
710
711
\end{code}

sof's avatar
sof committed
712
713
714
715
716
717
718

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

719
720
721
722
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:

723
\begin{itemize}
724
725
726
\item	(a) anything reachable from its body code
\item	(b) any module exported with a @module Foo@
\item   (c) anything reachable from an exported item
727
\end{itemize}
728
729

Why (b)?  Because if @Foo@ changes then this module's export list
730
731
732
733
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.

734
Why (c)?  Consider this:
735
736
737
738
739
\begin{verbatim}
	module A( f, g ) where	|	module B( f ) where
	  import B( f )		|	  f = h 3
	  g = ...		|	  h = ...
\end{verbatim}
740

741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
Here, @B.f@ isn't used in A.  Should we nevertheless record @B.f@ in
@A@'s usages?  Our idea is that we aren't going to touch A.hi if it is
*identical* to what it was before.  If anything about @B.f@ changes
than anyone who imports @A@ should be recompiled in case they use
@B.f@ (they'll get an early exit if they don't).  So, if anything
about @B.f@ changes we'd better make sure that something in A.hi
changes, and the convenient way to do that is to record the version
number @B.f@ in A.hi in the usage list.  If B.f changes that'll force a
complete recompiation of A, which is overkill but it's the only way to 
write a new, slightly different, A.hi.

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

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

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

770
\begin{code}
771
772
773
774
775
mkImportInfo :: ModuleName			-- Name of this module
	     -> [ImportDecl n]			-- The import decls
	     -> RnMG [ImportVersion Name]

mkImportInfo this_mod imports
776
  = getIfacesRn					`thenRn` \ ifaces ->
777
    getHomeIfaceTableRn				`thenRn` \ hit -> 
778
    let
779
780
781
	import_all_mods :: [ModuleName]
		-- Modules where we imported all the names
		-- (apart from hiding some, perhaps)
782
783
	import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports,
				    import_all imp_list ]
784
785
786

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

788
789
	mod_map   = iImpModInfo ifaces
	imp_names = iVSlurp     ifaces
790
	pit	  = iPIT 	ifaces
791

792
	-- mv_map groups together all the things imported from a particular module.
793
	mv_map :: ModuleEnv [Name]
794
	mv_map = foldr add_mv emptyModuleEnv imp_names
795

796
        add_mv name mv_map = addItem mv_map (nameModule name) name
797

798
	-- Build the result list by adding info for each module.
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
	-- For (a) a library module, we don't record it at all unless it contains orphans
	-- 	   (We must never lose track of orphans.)
	-- 
	--     (b) a source-imported module, don't record the dependency at all
	--	
	-- (b) may seem a bit strange.  The idea is that the usages in a .hi file records
	-- *all* the module's dependencies other than the loop-breakers.  We use
	-- this info in findAndReadInterface to decide whether to look for a .hi file or
	-- a .hi-boot file.  
	--
	-- This means we won't track version changes, or orphans, from .hi-boot files.
	-- The former is potentially rather bad news.  It could be fixed by recording
	-- whether something is a boot file along with the usage info for it, but 
	-- I can't be bothered just now.

814
	mk_imp_info mod_name (has_orphans, is_boot, opened) so_far
815
816
817
818
819
820
	   | mod_name == this_mod	-- Check if M appears in the set of modules 'below' M
					-- This seems like a convenient place to check
	   = WARN( not is_boot, ptext SLIT("Wierd:") <+> ppr this_mod <+> 
			        ptext SLIT("imports itself (perhaps indirectly)") )
	     so_far
 
821
	   | not opened 		-- We didn't even open the interface
822
	   =		-- This happens when a module, Foo, that we explicitly imported has 
823
824
825
			-- 'import Baz' in its interface file, recording that Baz is below
			-- Foo in the module dependency hierarchy.  We want to propagate this
			-- information.  The Nothing says that we didn't even open the interface
826
			-- file but we must still propagate the dependency info.
827
			-- The module in question must be a local module (in the same package)
828
829
	     go_for_it NothingAtAll

830

831
	   | is_lib_module && not has_orphans
832
	   = so_far		
833
	   
834
	   | is_lib_module 			-- Record the module version only
835
	   = go_for_it (Everything module_vers)
836

837
	   | otherwise
838
	   = go_for_it whats_imported
839
840
841
842
843
844
845
846

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

849
850
		whats_imported = Specifically module_vers
					      export_vers import_items 
851
852
853
					      (vers_rules version_info)

	        import_items = [(n,v) | n <- lookupWithDefaultModuleEnv mv_map [] mod,
854
				        let v = lookupNameEnv version_env n `orElse` 
855
856
					        pprPanic "mk_whats_imported" (ppr n)
			       ]
857
858
859
860
	        export_vers | moduleName mod `elem` import_all_mods 
			    = Just (vers_exports version_info)
			    | otherwise
			    = Nothing
861
	
862
	import_info = foldFM mk_imp_info [] mod_map
sof's avatar
sof committed
863
    in
864
    traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map)))	`thenRn_`
865
    returnRn import_info
866

867

868
addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a]
869
addItem fm mod x = extendModuleEnv_C add_item fm mod [x]
870
871
		 where
		   add_item xs _ = x:xs
872
\end{code}
873

sof's avatar
sof committed
874
\begin{code}
875
getSlurped
sof's avatar
sof committed
876
  = getIfacesRn 	`thenRn` \ ifaces ->
877
    returnRn (iSlurp ifaces)
sof's avatar
sof committed
878

879
recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = imp_names })
880
	    avail
881
  = let
sof's avatar
sof committed
882
	new_slurped_names = addAvailToNameSet slurped_names avail
883
	new_imp_names     = availName avail : imp_names
884
885
    in
    ifaces { iSlurp  = new_slurped_names, iVSlurp = new_imp_names }
sof's avatar
sof committed
886

887
888
889
890
recordLocalSlurps local_avails
  = getIfacesRn 	`thenRn` \ ifaces ->
    let
	new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
sof's avatar
sof committed
891
    in
892
    setIfacesRn (ifaces { iSlurp  = new_slurped_names })
sof's avatar
sof committed
893
894
895
\end{code}


896
897
898
899
900
901
902
903
904
905
%*********************************************************
%*							*
\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@).

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

909
\begin{code}
910
getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name)	-- New-name function
911
		-> RdrNameHsDecl
912
		-> RnM d (Maybe AvailInfo)
913

914
915
916
917
918
getDeclBinders new_name (TyClD tycl_decl)
  = mapRn do_one (tyClDeclNames tycl_decl)	`thenRn` \ (main_name:sub_names) ->
    returnRn (Just (AvailTC main_name (main_name : sub_names)))
  where
    do_one (name,loc) = new_name name loc
919
920
921

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

sof's avatar
sof committed
924
925
926
927
928
929
    -- 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))

930
931
  | otherwise 		-- a foreign export
  = lookupOrigName nm `thenRn_` 
sof's avatar
sof committed
932
933
    returnRn Nothing

934
935
936
937
938
getDeclBinders new_name (FixD _)    = returnRn Nothing
getDeclBinders new_name (DeprecD _) = returnRn Nothing
getDeclBinders new_name (DefD _)    = returnRn Nothing
getDeclBinders new_name (InstD _)   = returnRn Nothing
getDeclBinders new_name (RuleD _)   = returnRn Nothing
939

sof's avatar
sof committed
940
941
binds_haskell_name (FoImport _) _   = True
binds_haskell_name FoLabel      _   = True
942
binds_haskell_name FoExport  ext_nm = isDynamicExtName ext_nm
943
944
\end{code}

945
946
@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.
947
948
They aren't returned by @getDeclBinders@ because they aren't in scope;
but they {\em should} be put into the @DeclsMap@ of this module.
949

950
951
952
953
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.

954
\begin{code}
955
getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ names src_loc))
956
  = sequenceRn [new_name n src_loc | n <- names]
957

958
getDeclSysBinders new_name (TyClD (TyData _ _ _ _ cons _ _ _ _ _))
959
  = sequenceRn [new_name wkr_name src_loc | ConDecl _ wkr_name _ _ _ src_loc <- cons]
960
961
962
963

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

965
966
967
968
969
970
%*********************************************************
%*							*
\subsection{Reading an interface file}
%*							*
%*********************************************************

971
\begin{code}
972
973
974
findAndReadIface :: SDoc -> ModuleName 
		 -> IsBootInterface	-- True  <=> Look for a .hi-boot file
					-- False <=> Look for .hi file
975
		 -> RnM d (Either Message (Module, ParsedIface))
976
977
	-- Nothing <=> file not found, or unreadable, or illegible
	-- Just x  <=> successfully found and parsed 
978

979
findAndReadIface doc_str mod_name hi_boot_file
980
  = traceRn trace_msg			`thenRn_`
981
982
983
      -- 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.
984

985
986
    getFinderRn				`thenRn` \ finder ->
    ioToRnM (finder mod_name)		`thenRn` \ maybe_found ->
987

988
    case maybe_found of
989
      Right (Just (mod,locn))
990
991
	| hi_boot_file -> readIface mod (hi_file locn ++ "-hi-boot")
	| otherwise    -> readIface mod (hi_file locn)
992
	
993
	-- Can't find it
994
      other   -> traceRn (ptext SLIT("...not found"))	`thenRn_`
995
		 returnRn (Left (noIfaceErr mod_name hi_boot_file))
996

997
  where
sof's avatar
sof committed
998
    trace_msg = sep [hsep [ptext SLIT("Reading"), 
999
			   if hi_boot_file then ptext SLIT("[boot]") else empty,
sof's avatar
sof committed
1000
			   ptext SLIT("interface for"), 
1001
			   ppr mod_name <> semi],
sof's avatar
sof committed
1002
		     nest 4 (ptext SLIT("reason:") <+> doc_str)]
1003
\end{code}
1004

sof's avatar
sof committed
1005
@readIface@ tries just the one file.
1006

1007
\begin{code}