RnIfaces.lhs 40.6 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
14
15
	lookupFixityRn, loadHomeInterface,
	importDecl, ImportDeclResult(..), recordLocalSlurps, loadBuiltinRules,
	mkImportExportInfo, 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 HsSyn		( HsDecl(..), TyClDecl(..), InstDecl(..), IfaceSig(..), 
26
			  HsType(..), ConDecl(..), IE(..), ConDetails(..), Sig(..),
27
			  ForeignDecl(..), ForKind(..), isDynamicExtName,
28
			  FixitySig(..), RuleDecl(..),
29
			  isClassOpSig, DeprecDecl(..)
30
			)
31
32
import HsImpExp		( ieNames )
import CoreSyn		( CoreRule )
33
import BasicTypes	( Version, defaultFixity )
34
35
import RdrHsSyn		( RdrNameHsDecl, RdrNameInstDecl, RdrNameRuleDecl,
			  RdrNameDeprecation, RdrNameIE,
36
			  extractHsTyRdrNames 
37
			)
38
import RnEnv
39
import RnMonad
40
import ParseIface	( parseIface, IfaceStuff(..) )
41

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

import List	( nub )
68
69
\end{code}

70

71
72
73
74
75
%*********************************************************
%*							*
\subsection{Loading a new interface file}
%*							*
%*********************************************************
76

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

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

94
95
96
97
98
99
100
101
102
103
104
105
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
106
 = getIfacesRn 			`thenRn` \ ifaces ->
sof's avatar
sof committed
107
   let
108
109
110
	mod_map  = iImpModInfo ifaces
	mod_info = lookupFM mod_map mod_name

111
112
113
114
115
116
117
118
119
120
121
	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.

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

133
134
135
136
137
138
139
	_ ->

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

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

	-- Found and parsed!
154
	Right (mod, iface) ->
155
156

	-- LOAD IT INTO Ifaces
157

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

163

164
165
166
167
	-- 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 } &&
168
	  isModuleInThisPackage mod,
169
	  ppr mod )
170
171
172
173

    loadDecls mod		(iDecls ifaces)	  (pi_decls iface)	`thenRn` \ (decls_vers, new_decls) ->
    loadRules mod		(iRules ifaces)   (pi_rules iface)	`thenRn` \ (rule_vers, new_rules) ->
    loadFixDecls mod_name	 		  (pi_fixity iface)	`thenRn` \ (fix_vers, fix_env) ->
174
    foldlRn (loadDeprec mod)	emptyNameEnv	  (pi_deprecs iface)	`thenRn` \ deprec_env ->
175
    foldlRn (loadInstDecl mod)	(iInsts ifaces)   (pi_insts iface)	`thenRn` \ new_insts ->
176
    loadExports 			 	  (pi_exports iface)	`thenRn` \ avails ->
177
    let
178
179
180
	version	= VersionInfo { modVers  = pi_vers iface, 
				fixVers  = fix_vers,
				ruleVers = rule_vers,
181
				declVers = decls_vers }
182

183
184
185
186
	-- 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
187
			ImportByUser -> addModDeps mod (pi_usages iface) mod_map
188
			other        -> mod_map
189
190
191
192
193
194
195
196
197
198
199
200
	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"
		    }
201

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

212
213
214
215
216
-----------------------------------------------------
--	Adding module dependencies from the 
--	import decls in the interface file
-----------------------------------------------------

217
addModDeps :: Module -> [ImportVersion a] 
218
219
220
221
222
	   -> 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
223
  where
224
225
226
	-- 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
227
    filtered_new_deps :: [(ModuleName, (WhetherHasOrphans, IsBootInterface))]
228
    filtered_new_deps
229
230
	| isModuleInThisPackage mod 
			    = [ (imp_mod, (has_orphans, is_boot, False))
231
			      | (imp_mod, has_orphans, is_boot, _) <- new_deps 
232
			      ]			      
233
	| otherwise	    = [ (imp_mod, (True, False, False))
234
			      | (imp_mod, has_orphans, _, _) <- new_deps, 
235
236
237
				has_orphans
			      ]
    add (imp_mod, dep) deps = addToFM_C combine deps imp_mod dep
238

239
240
    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
241
							-- or if it's a non-boot pending load
242
	| otherwise			    = new	-- Otherwise pick new info
243

244
245
246
247
248

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

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


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

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

288

289
290
291
-----------------------------------------------------
--	Loading type/class/value decls
-----------------------------------------------------
292

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

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

310
311
    getDeclSysBinders new_name decl	`thenRn` \ sys_bndrs ->
    let
312
313
314
315
316
	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!

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

	new_version_map = extendNameEnv version_map main_name version
326
    in
327
    returnRn (new_version_map, new_decls_map)
328
    }
329
  where
330
	-- newTopBinder puts into the cache the binder with the
331
332
	-- module information set correctly.  When the decl is later renamed,
	-- the binding site will thereby get the correct module.
333
334
335
	-- 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
336
    new_name rdr_name loc = newTopBinder mod rdr_name loc
337

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

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

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

359
360
361
362
-----------------------------------------------------
--	Loading fixity decls
-----------------------------------------------------

363
loadFixDecls mod_name (version, decls)
364
  = mapRn (loadFixDecl mod_name) decls	`thenRn` \ to_add ->
365
    returnRn (version, mkNameEnv to_add)
366
367

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


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

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

399
400
401
402
403
404
405
406

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

407
removeFuns (HsFunTy _ ty) = removeFuns ty
408
409
410
removeFuns ty		    = ty


411
412
413
414
415
416
-----------------------------------------------------
--	Loading Rules
-----------------------------------------------------

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

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

loadBuiltinRules :: [(RdrName, CoreRule)] -> RnMG ()
loadBuiltinRules builtin_rules
  = getIfacesRn				`thenRn` \ ifaces ->
    mapRn loadBuiltinRule builtin_rules	`thenRn` \ rule_decls ->
    setIfacesRn (ifaces { iRules = iRules ifaces `unionBags` listToBag rule_decls })

loadBuiltinRule (var, rule)
440
  = lookupOrigName var		`thenRn` \ var_name ->
441
442
443
444
445
446
    returnRn (unitNameSet var_name, (nameModule var_name, RuleD (IfaceRuleOut var rule)))


-----------------------------------------------------
--	Loading Deprecations
-----------------------------------------------------
447
448

loadDeprec :: Module -> DeprecationEnv -> RdrNameDeprecation -> RnM d DeprecationEnv
449
loadDeprec mod deprec_env (Deprecation (IEModuleContents _) txt _)
450
  = traceRn (text "module deprecation not yet implemented:" <+> ppr mod <> colon <+> ppr txt) `thenRn_`
451
	-- SUP: TEMPORARY HACK, ignoring module deprecations for now
452
    returnRn deprec_env
453
454

loadDeprec mod deprec_env (Deprecation ie txt _)
455
456
  = setModuleRn mod					$
    mapRn lookupOrigName (ieNames ie)		`thenRn` \ names ->
457
    traceRn (text "loaded deprecation(s) for" <+> hcat (punctuate comma (map ppr names)) <> colon <+> ppr txt) `thenRn_`
458
    returnRn (extendNameEnvList deprec_env (zip names (repeat txt)))
459
\end{code}
460

461

462
463
464
465
466
%*********************************************************
%*							*
\subsection{Getting in a declaration}
%*							*
%*********************************************************
467

468
\begin{code}
469
470
471
472
473
474
475
importDecl :: Name -> RnMG ImportDeclResult

data ImportDeclResult
  = AlreadySlurped
  | WiredIn	
  | Deferred
  | HereItIs (Module, RdrNameHsDecl)
476
477

importDecl name
478
479
480
481
482
483
484
485
486
  = 	-- 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	
487
	returnRn AlreadySlurped	
488
    else 
489

490
491
492
	-- Don't slurp in decls from this module's own interface file
	-- (Indeed, this shouldn't happen.)
    if isLocallyDefined name then
493
494
	addWarnRn (importDeclWarn name) `thenRn_`
	returnRn AlreadySlurped
495
    else
496

497
498
499
	-- 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
500
501
502
503
504
505
506
507
	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
508
getNonWiredInDecl needed_name 
509
  = traceRn doc_str				`thenRn_`
510
    loadHomeInterface doc_str needed_name	`thenRn` \ ifaces ->
511
    case lookupNameEnv (iDecls ifaces) needed_name of
sof's avatar
sof committed
512

513
{- 		OMIT DEFERRED STUFF FOR NOW, TILL GHCI WORKS
514
      Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _ _ _)))
515
516
517
518
519
520
521
522
523
524
525
526
527
528
	-- 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

529
530
531
532

	->  	-- 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
533
534
535
536
537
538
		-- 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
539

540
	    else
541
	  	-- The needed name is a constructor of a data type decl,
542
543
		-- getting a constructor, so remove the TyCon from the deferred set
		-- (if it's there) and return the full declaration
544
		setIfacesRn (recordSlurp (ifaces {iDeferred = iDeferred ifaces 
545
546
							       `delFromNameSet` tycon_name})
				    version avail)	`thenRn_`
547
		returnRn (HereItIs decl)
548
549
	where
	   tycon_name = availName avail
550
-}
551

552
553
      Just (avail,_,decl)
	-> setIfacesRn (recordSlurp ifaces avail)	`thenRn_`
554
	   returnRn (HereItIs decl)
555

556
      Nothing 
557
	-> addErrRn (getDeclErr needed_name)	`thenRn_` 
558
	   returnRn AlreadySlurped
559
  where
560
     doc_str = ptext SLIT("need decl for") <+> ppr needed_name
561

562
{-		OMIT FOR NOW
563
564
565
566
567
568
569
570
571
572
573
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)
574
-}
575
576
\end{code}

577
578
579
@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,
580
581
\begin{itemize}
\item	if the wired-in name is a data type constructor or a data constructor, 
582
	it brings in the type constructor and all the data constructors; and
583
	marks as ``occurrences'' any free vars of the data con.
584

585
\item 	similarly for synonum type constructor
586

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

590
\item	it loads the interface file for the wired-in thing for the
591
	sole purpose of making sure that its instance declarations are available
592
593
\end{itemize}
All this is necessary so that we know all types that are ``in play'', so
594
595
that we know just what instances to bring into scope.
	
596
597


598
    
599
600
%*********************************************************
%*							*
sof's avatar
sof committed
601
\subsection{Getting what a module exports}
602
603
%*							*
%*********************************************************
604

605
@getInterfaceExports@ is called only for directly-imported modules.
606

607
\begin{code}
608
609
getInterfaceExports :: ModuleName -> WhereFrom -> RnMG (Module, Avails)
getInterfaceExports mod_name from
610
611
612
613
614
615
616
617
618
619
620
  = 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)
621
622
    }
    where
623
      doc_str = sep [ppr mod_name, ptext SLIT("is directly imported")]
sof's avatar
sof committed
624
625
626
627
628
\end{code}


%*********************************************************
%*							*
629
\subsection{Instance declarations are handled specially}
sof's avatar
sof committed
630
631
632
633
%*							*
%*********************************************************

\begin{code}
634
635
getImportedInstDecls :: NameSet -> RnMG [(Module,RdrNameHsDecl)]
getImportedInstDecls gates
636
  =    	-- First, load any orphan-instance modules that aren't aready loaded
637
	-- Orphan-instance modules are recorded in the module dependecnies
638
    getIfacesRn 					`thenRn` \ ifaces ->
sof's avatar
sof committed
639
    let
640
	orphan_mods =
641
	  [mod | (mod, (True, _, False)) <- fmToList (iImpModInfo ifaces)]
sof's avatar
sof committed
642
    in
643
    loadOrphanModules orphan_mods			`thenRn_` 
644

645
	-- Now we're ready to grab the instance declarations
646
647
	-- Find the un-gated ones and return them, 
	-- removing them from the bag kept in Ifaces
648
    getIfacesRn 					`thenRn` \ ifaces ->
649
    let
650
651
652
	(decls, new_insts) = selectGated gates (iInsts ifaces)
    in
    setIfacesRn (ifaces { iInsts = new_insts })		`thenRn_`
653

654
    traceRn (sep [text "getImportedInstDecls:", 
655
		  nest 4 (fsep (map ppr gate_list)),
656
657
		  text "Slurped" <+> int (length decls) <+> text "instance declarations",
		  nest 4 (vcat (map ppr_brief_inst_decl decls))])	`thenRn_`
658
659
    returnRn decls
  where
660
661
    gate_list      = nameSetToList gates

662
663
664
665
666
ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
  = case inst_ty of
	HsForAllTy _ _ tau -> ppr tau
	other		   -> ppr inst_ty

667
getImportedRules :: RnMG [(Module,RdrNameHsDecl)]
668
669
670
getImportedRules 
  | opt_IgnoreIfacePragmas = returnRn []
  | otherwise
671
672
673
  = getIfacesRn 	`thenRn` \ ifaces ->
    let
	gates		   = iSlurp ifaces	-- Anything at all that's been slurped
674
675
	rules		   = iRules ifaces
	(decls, new_rules) = selectGated gates rules
676
    in
677
678
679
680
    if null decls then
	returnRn []
    else
    setIfacesRn (ifaces { iRules = new_rules })		     `thenRn_`
681
    traceRn (sep [text "getImportedRules:", 
682
		  text "Slurped" <+> int (length decls) <+> text "rules"])   `thenRn_`
683
    returnRn decls
684

685
selectGated gates decl_bag
686
	-- Select only those decls whose gates are *all* in 'gates'
687
688
689
#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
690

691
692
693
  | otherwise
#endif
  = foldrBag select ([], emptyBag) decl_bag
694
  where
695
696
697
698
    select (reqd, decl) (yes, no)
	| isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
	| otherwise				     = (yes,      (reqd,decl) `consBag` no)

699
700
lookupFixityRn :: Name -> RnMS Fixity
lookupFixityRn name
701
702
  | isLocallyDefined name
  = getFixityEnv			`thenRn` \ local_fix_env ->
703
    returnRn (lookupLocalFixity local_fix_env name)
704
705

  | otherwise	-- Imported
706
707
708
709
710
711
712
      -- 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.
713
  = getHomeIfaceTableRn 		`thenRn` \ hst ->
714
715
716
717
718
    case lookupFixityEnv hst name of {
	Just fixity -> returnRn fixity ;
	Nothing	    -> 

    loadHomeInterface doc name		`thenRn` \ ifaces ->
719
    returnRn (lookupFixityEnv (iPIT ifaces) name `orElse` defaultFixity) 
720
    }
721
  where
722
    doc = ptext SLIT("Checking fixity for") <+> ppr name
723
724
\end{code}

sof's avatar
sof committed
725
726
727
728
729
730
731

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

732
733
734
735
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:

736
\begin{itemize}
737
738
739
\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
740
\end{itemize}
741
742

Why (b)?  Because if @Foo@ changes then this module's export list
743
744
745
746
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.

747
Why (c)?  Consider this:
748
749
750
751
752
\begin{verbatim}
	module A( f, g ) where	|	module B( f ) where
	  import B( f )		|	  f = h 3
	  g = ...		|	  h = ...
\end{verbatim}
753

754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
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> :: ... ;
778
779
780
781
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.
782

783
\begin{code}
784
785
mkImportExportInfo :: ModuleName			-- Name of this module
		   -> Avails				-- Info about exports 
786
		   -> [ImportDecl n]			-- The import decls
787
		   -> RnMG ([ExportItem], 		-- Export info for iface file; sorted
788
			    [ImportVersion Name])	-- Import info for iface file; sorted
789
790
791
792
			-- Both results are sorted into canonical order to
			-- reduce needless wobbling of interface files

mkImportExportInfo this_mod export_avails exports
793
794
  = getIfacesRn					`thenRn` \ ifaces ->
    let
795
796
797
798
799
800
801
	import_all_mods :: [ModuleName]
		-- Modules where we imported all the names
		-- (apart from hiding some, perhaps)
	import_all_mods = nub [ m | ImportDecl m _ _ _ imp_list _ <- imports ]

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

803
804
	mod_map   = iImpModInfo ifaces
	imp_names = iVSlurp     ifaces
805

806
	-- mv_map groups together all the things imported from a particular module.
807
	mv_map :: ModuleEnv [Name]
808
	mv_map = foldr add_mv emptyFM imp_names
809

810
        add_mv (name, version) mv_map = addItem mv_map (nameModule name) name
811

812
	-- Build the result list by adding info for each module.
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
	-- 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.

828
	mk_imp_info mod_name (has_orphans, is_boot, opened) so_far
829
830
831
832
833
834
	   | 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
 
835
836
	   | not opened 		-- We didn't even open the interface
	   ->		-- This happens when a module, Foo, that we explicitly imported has 
837
838
839
840
			-- '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
			-- file but we must still propagate the dependeny info.
841
			-- The module in question must be a local module (in the same package)
842
843
	     go_for_it NothingAtAll

844

845
846
	   | is_lib_module && not has_orphans
	   -> so_far		
847
	   
848
849
	   |  is_lib_module 			-- Record the module version only
	   -> go_for_it (Everything mod_vers)
850

851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
	   |  otherwise
	   -> go_for_it (mk_whats_imported mod mod_vers)

		   where
		     
	     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

		whats_imported = Specifically mod_vers export_vers import_items 
					      (vers_rules version_info)

	        import_items = [(n,v) | n <- lookupWithDefaultModuleEnv mv_map [] mod,
				        let v = lookupNameEnv version_env `orElse` 
					        pprPanic "mk_whats_imported" (ppr n)
			       ]
	       export_vers | moduleName mod `elem` import_all_mods = Just (vers_exports version_info)
		   	   | otherwise			  	   = Nothing
	
874
875
876
	import_info = foldFM mk_imp_info [] mod_map

	-- Sort exports into groups by module
877
	export_fm :: FiniteMap Module [RdrAvailInfo]
878
879
	export_fm = foldr insert emptyFM export_avails

880
881
        insert avail efm = addItem efm (nameModule (availName avail))
				       avail
882

883
	export_info = fmToList export_fm
sof's avatar
sof committed
884
    in
885
    traceRn (text "Modules in Ifaces: " <+> fsep (map ppr (keysFM mod_map)))	`thenRn_`
886
    returnRn (export_info, import_info)
887

888

889
890
addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a]
addItem fm mod x = plusModuleEnv_C add_item fm mod [x]
891
892
		 where
		   add_item xs _ = x:xs
893
\end{code}
894

sof's avatar
sof committed
895
\begin{code}
896
getSlurped
sof's avatar
sof committed
897
  = getIfacesRn 	`thenRn` \ ifaces ->
898
    returnRn (iSlurp ifaces)
sof's avatar
sof committed
899

900
recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = imp_names })
901
	    avail
902
  = let
sof's avatar
sof committed
903
	new_slurped_names = addAvailToNameSet slurped_names avail
904
	new_imp_names     = availName avail : imp_names
905
906
    in
    ifaces { iSlurp  = new_slurped_names, iVSlurp = new_imp_names }
sof's avatar
sof committed
907

908
909
910
911
recordLocalSlurps local_avails
  = getIfacesRn 	`thenRn` \ ifaces ->
    let
	new_slurped_names = foldl addAvailToNameSet (iSlurp ifaces) local_avails
sof's avatar
sof committed
912
    in
913
    setIfacesRn (ifaces { iSlurp  = new_slurped_names })
sof's avatar
sof committed
914
915
916
\end{code}


917
918
919
920
921
922
923
924
925
926
%*********************************************************
%*							*
\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@).

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

930
\begin{code}
931
getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name)	-- New-name function
932
		-> RdrNameHsDecl
933
		-> RnM d (Maybe AvailInfo)
934

935
getDeclBinders new_name (TyClD (TyData _ _ tycon _ condecls _ _ _ src_loc _ _))
936
937
  = new_name tycon src_loc			`thenRn` \ tycon_name ->
    getConFieldNames new_name condecls		`thenRn` \ sub_names ->
938
    returnRn (Just (AvailTC tycon_name (tycon_name : nub sub_names)))
sof's avatar
sof committed
939
940
	-- The "nub" is because getConFieldNames can legitimately return duplicates,
	-- when a record declaration has the same field in multiple constructors
941

942
getDeclBinders new_name (TyClD (TySynonym tycon _ _ src_loc))
943
  = new_name tycon src_loc		`thenRn` \ tycon_name ->
944
    returnRn (Just (AvailTC tycon_name [tycon_name]))
945

946
getDeclBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ _ src_loc))
947
  = new_name cname src_loc			`thenRn` \ class_name ->
948
949

	-- Record the names for the class ops
sof's avatar
sof committed
950
    let
sof's avatar
sof committed
951
952
	-- just want class-op sigs
	op_sigs = filter isClassOpSig sigs
sof's avatar
sof committed
953
    in
sof's avatar
sof committed
954
    mapRn (getClassOpNames new_name) op_sigs	`thenRn` \ sub_names ->
955

956
    returnRn (Just (AvailTC class_name (class_name : sub_names)))
957
958
959

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

962
963
getDeclBinders new_name (FixD _)    = returnRn Nothing
getDeclBinders new_name (DeprecD _) = returnRn Nothing
sof's avatar
sof committed
964
965
966
967
968
969
970

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

971
972
  | otherwise 		-- a foreign export
  = lookupOrigName nm `thenRn_` 
sof's avatar
sof committed
973
974
    returnRn Nothing

975
976
getDeclBinders new_name (DefD _)  = returnRn Nothing
getDeclBinders new_name (InstD _) = returnRn Nothing
977
getDeclBinders new_name (RuleD _) = returnRn Nothing
978

sof's avatar
sof committed
979
980
binds_haskell_name (FoImport _) _   = True
binds_haskell_name FoLabel      _   = True
981
binds_haskell_name FoExport  ext_nm = isDynamicExtName ext_nm
sof's avatar
sof committed
982

983
----------------
984
getConFieldNames new_name (ConDecl con _ _ _ (RecCon fielddecls) src_loc : rest)
985
986
987
  = mapRn (\n -> new_name n src_loc) (con:fields)	`thenRn` \ cfs ->
    getConFieldNames new_name rest			`thenRn` \ ns  -> 
    returnRn (cfs ++ ns)
988
  where
989
990
    fields = concat (map fst fielddecls)

991
getConFieldNames new_name (ConDecl con _ _ _ condecl src_loc : rest)
sof's avatar
sof committed
992
993
  = new_name con src_loc		`thenRn` \ n ->
    getConFieldNames new_name rest	`thenRn` \ ns -> 
994
    returnRn (n : ns)
sof's avatar
sof committed
995

996
getConFieldNames new_name [] = returnRn []
997

998
getClassOpNames new_name (ClassOpSig op _ _ src_loc) = new_name op src_loc
999
1000
\end{code}

1001
1002
@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.
1003
1004
They aren't returned by @getDeclBinders@ because they aren't in scope;
but they {\em should} be put into the @DeclsMap@ of this module.
1005

1006
1007
1008
1009
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.

1010
\begin{code}
1011
1012
1013
getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ _ names 
				   src_loc))
  = sequenceRn [new_name n src_loc | n <- names]
1014

1015
getDeclSysBinders new_name (TyClD (TyData _ _ _ _ cons _ _ _ _ _ _))
1016
  = sequenceRn [new_name wkr_name src_loc | ConDecl _ wkr_name _ _ _ src_loc <- cons]
1017
1018
1019
1020

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

1022
1023
1024
1025
1026
1027
%*********************************************************
%*							*
\subsection{Reading an interface file}
%*							*
%*********************************************************

1028
\begin{code}
1029
1030
1031
findAndReadIface :: SDoc -> ModuleName 
		 -> IsBootInterface	-- True  <=> Look for a .hi-boot file
					-- False <=> Look for .hi file
1032
		 -> RnM d (Either Message (Module, ParsedIface))