RnIfaces.lhs 38.5 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
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
101
102
	-- Guarantees to return with iImpModInfo m --> (..., True)
	-- (If the load fails, we plug in a vanilla placeholder)
103
tryLoadInterface doc_str mod_name from
104
105
106
107
108
109
110
111
 = getHomeIfaceTableRn		`thenRn` \ hit ->
   getIfacesRn 			`thenRn` \ ifaces ->
	
	-- Check whether we have it already in the home package
   case lookupModuleEnvByName hit mod_name of {
	Just _  -> returnRn (ifaces, Nothing) ;	-- In the home package
	Nothing -> 

sof's avatar
sof committed
112
   let
113
114
115
	mod_map  = iImpModInfo ifaces
	mod_info = lookupFM mod_map mod_name

116
117
118
119
120
121
122
123
124
125
126
	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.

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

138
139
140
141
142
143
144
	_ ->

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

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

	-- Found and parsed!
159
	Right (mod, iface) ->
160
161

	-- LOAD IT INTO Ifaces
162

sof's avatar
sof committed
163
164
165
166
	-- 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)
167

168

169
170
171
172
	-- 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 } &&
173
	  isModuleInThisPackage mod,
174
	  ppr mod )
175
176
177

    loadDecls mod		(iDecls ifaces)	  (pi_decls iface)	`thenRn` \ (decls_vers, new_decls) ->
    loadRules mod		(iRules ifaces)   (pi_rules iface)	`thenRn` \ (rule_vers, new_rules) ->
178
179
    loadFixDecls mod_name	 		  (pi_fixity iface)	`thenRn` \ fix_env ->
    loadDeprecs mod				  (pi_deprecs iface)	`thenRn` \ deprec_env ->
180
    foldlRn (loadInstDecl mod)	(iInsts ifaces)   (pi_insts iface)	`thenRn` \ new_insts ->
181
    loadExports 			 	  (pi_exports iface)	`thenRn` \ (export_vers, avails) ->
182
    let
183
	version	= VersionInfo { vers_module  = pi_vers iface, 
184
				vers_exports = export_vers,
185
186
				vers_rules = rule_vers,
				vers_decls = decls_vers }
187

188
189
190
191
	-- 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
192
			ImportByUser -> addModDeps mod (pi_usages iface) mod_map
193
			other        -> mod_map
194
195
196
197
198
199
200
201
202
203
204
205
	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"
		    }
206

207
	new_ifaces = ifaces { iPIT	  = new_pit,
208
			      iDecls      = new_decls,
209
			      iInsts      = new_insts,
210
			      iRules	  = new_rules,
211
			      iImpModInfo = mod_map2  }
212
    in
213
    setIfacesRn new_ifaces		`thenRn_`
214
    returnRn (new_ifaces, Nothing)
215
    }}}
sof's avatar
sof committed
216

217
218
219
220
221
-----------------------------------------------------
--	Adding module dependencies from the 
--	import decls in the interface file
-----------------------------------------------------

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

244
245
    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
246
							-- or if it's a non-boot pending load
247
	| otherwise			    = new	-- Otherwise pick new info
248

249
250
251
252
253

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

254
255
loadExports :: (Version, [ExportItem]) -> RnM d (Version, Avails)
loadExports (vers, items)
256
257
  = getModuleRn 				`thenRn` \ this_mod ->
    mapRn (loadExport this_mod) items		`thenRn` \ avails_s ->
258
    returnRn (vers, concat avails_s)
259
260


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

sof's avatar
sof committed
285
286
    load_entity mod (Avail occ)
      =	new_name mod occ	`thenRn` \ name ->
sof's avatar
sof committed
287
	returnRn (Avail name)
sof's avatar
sof committed
288
289
290
    load_entity mod (AvailTC occ occs)
      =	new_name mod occ	      `thenRn` \ name ->
        mapRn (new_name mod) occs     `thenRn` \ names ->
sof's avatar
sof committed
291
        returnRn (AvailTC name names)
292

293

294
295
296
-----------------------------------------------------
--	Loading type/class/value decls
-----------------------------------------------------
297

298
299
300
301
302
303
304
loadDecls :: Module 
	  -> DeclsMap
	  -> [(Version, RdrNameHsDecl)]
	  -> RnM d (NameEnv Version, DeclsMap)
loadDecls mod decls_map decls
  = foldlRn (loadDecl mod) (emptyNameEnv, decls_map) decls

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

315
316
    getDeclSysBinders new_name decl	`thenRn` \ sys_bndrs ->
    let
317
318
319
320
321
	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!

322
323
	main_name     = availName avail
	new_decls_map = foldl add_decl decls_map
324
				       [ (name, (full_avail, name==main_name, (mod, decl'))) 
325
				       | name <- availNames full_avail]
326
	add_decl decls_map (name, stuff)
327
	  = WARN( name `elemNameEnv` decls_map, ppr name )
328
	    extendNameEnv decls_map name stuff
329
330

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

sof's avatar
sof committed
343
    {-
344
345
      If a signature decl is being loaded, and optIgnoreIfacePragmas is on,
      we toss away unfolding information.
sof's avatar
sof committed
346
347
348
349
350

      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
351
352
      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
353
      just ignore unfolding info.
354
355
356
357

      [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
358
    -}
359
    decl' = case decl of
360
361
362
	       SigD (IfaceSig name tp ls loc) | opt_IgnoreIfacePragmas
			 ->  SigD (IfaceSig name tp [] loc)
	       other	 -> decl
sof's avatar
sof committed
363

364
365
366
367
-----------------------------------------------------
--	Loading fixity decls
-----------------------------------------------------

368
loadFixDecls mod_name decls
369
  = mapRn (loadFixDecl mod_name) decls	`thenRn` \ to_add ->
370
    returnRn (mkNameEnv to_add)
371
372

loadFixDecl mod_name sig@(FixitySig rdr_name fixity loc)
373
  = newGlobalName mod_name (rdrNameOcc rdr_name) 	`thenRn` \ name ->
374
    returnRn (name, fixity)
375
376
377
378
379
380


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

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

404
405
406
407
408
409
410
411

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

412
removeFuns (HsFunTy _ ty) = removeFuns ty
413
414
415
removeFuns ty		    = ty


416
417
418
419
420
421
-----------------------------------------------------
--	Loading Rules
-----------------------------------------------------

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

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


-----------------------------------------------------
--	Loading Deprecations
-----------------------------------------------------
442

443
444
445
446
447
448
449
450
451
452
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)
453
\end{code}
454

455

456
457
458
459
460
%*********************************************************
%*							*
\subsection{Getting in a declaration}
%*							*
%*********************************************************
461

462
\begin{code}
463
464
465
466
467
468
469
importDecl :: Name -> RnMG ImportDeclResult

data ImportDeclResult
  = AlreadySlurped
  | WiredIn	
  | Deferred
  | HereItIs (Module, RdrNameHsDecl)
470
471

importDecl name
472
473
474
475
476
477
478
479
480
  = 	-- 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	
481
	returnRn AlreadySlurped	
482
    else 
483

484
485
486
	-- Don't slurp in decls from this module's own interface file
	-- (Indeed, this shouldn't happen.)
    if isLocallyDefined name then
487
488
	addWarnRn (importDeclWarn name) `thenRn_`
	returnRn AlreadySlurped
489
    else
490

491
492
493
	-- 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
494
495
496
497
498
499
500
501
	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
502
getNonWiredInDecl needed_name 
503
  = traceRn doc_str				`thenRn_`
504
    loadHomeInterface doc_str needed_name	`thenRn` \ ifaces ->
505
    case lookupNameEnv (iDecls ifaces) needed_name of
sof's avatar
sof committed
506

507
{- 		OMIT DEFERRED STUFF FOR NOW, TILL GHCI WORKS
508
      Just (version, avail, is_tycon_name, decl@(_, TyClD (TyData DataType _ _ _ _ ncons _ _ _ _)))
509
510
511
512
513
514
515
516
517
518
519
520
521
522
	-- 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

523
524
525
526

	->  	-- 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
527
528
529
530
531
532
		-- 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
533

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

546
547
      Just (avail,_,decl)
	-> setIfacesRn (recordSlurp ifaces avail)	`thenRn_`
548
	   returnRn (HereItIs decl)
549

550
      Nothing 
551
	-> addErrRn (getDeclErr needed_name)	`thenRn_` 
552
	   returnRn AlreadySlurped
553
  where
554
     doc_str = ptext SLIT("need decl for") <+> ppr needed_name
555

556
{-		OMIT FOR NOW
557
558
559
560
561
562
563
564
565
566
567
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)
568
-}
569
570
\end{code}

571
572
573
@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,
574
575
\begin{itemize}
\item	if the wired-in name is a data type constructor or a data constructor, 
576
	it brings in the type constructor and all the data constructors; and
577
	marks as ``occurrences'' any free vars of the data con.
578

579
\item 	similarly for synonum type constructor
580

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

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


592
    
593
594
%*********************************************************
%*							*
sof's avatar
sof committed
595
\subsection{Getting what a module exports}
596
597
%*							*
%*********************************************************
598

599
@getInterfaceExports@ is called only for directly-imported modules.
600

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


%*********************************************************
%*							*
623
\subsection{Instance declarations are handled specially}
sof's avatar
sof committed
624
625
626
627
%*							*
%*********************************************************

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

639
	-- Now we're ready to grab the instance declarations
640
641
	-- Find the un-gated ones and return them, 
	-- removing them from the bag kept in Ifaces
642
    getIfacesRn 					`thenRn` \ ifaces ->
643
    let
644
645
646
	(decls, new_insts) = selectGated gates (iInsts ifaces)
    in
    setIfacesRn (ifaces { iInsts = new_insts })		`thenRn_`
647

648
    traceRn (sep [text "getImportedInstDecls:", 
649
		  nest 4 (fsep (map ppr gate_list)),
650
651
		  text "Slurped" <+> int (length decls) <+> text "instance declarations",
		  nest 4 (vcat (map ppr_brief_inst_decl decls))])	`thenRn_`
652
653
    returnRn decls
  where
654
655
    gate_list      = nameSetToList gates

656
657
658
659
660
ppr_brief_inst_decl (mod, InstD (InstDecl inst_ty _ _ _ _))
  = case inst_ty of
	HsForAllTy _ _ tau -> ppr tau
	other		   -> ppr inst_ty

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

679
selectGated gates decl_bag
680
	-- Select only those decls whose gates are *all* in 'gates'
681
682
683
#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
684

685
686
687
  | otherwise
#endif
  = foldrBag select ([], emptyBag) decl_bag
688
  where
689
690
691
692
    select (reqd, decl) (yes, no)
	| isEmptyNameSet (reqd `minusNameSet` gates) = (decl:yes, no)
	| otherwise				     = (yes,      (reqd,decl) `consBag` no)

693
694
lookupFixityRn :: Name -> RnMS Fixity
lookupFixityRn name
695
696
  | isLocallyDefined name
  = getFixityEnv			`thenRn` \ local_fix_env ->
697
    returnRn (lookupLocalFixity local_fix_env name)
698
699

  | otherwise	-- Imported
700
701
702
703
704
705
706
      -- 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.
707
  = getHomeIfaceTableRn 		`thenRn` \ hit ->
708
    loadHomeInterface doc name		`thenRn` \ ifaces ->
709
710
711
    case lookupTable hit (iPIT ifaces) name of
	Just iface -> returnRn (lookupNameEnv (mi_fixities iface) name `orElse` defaultFixity)
	Nothing	   -> returnRn defaultFixity
712
  where
713
    doc = ptext SLIT("Checking fixity for") <+> ppr name
714
715
\end{code}

sof's avatar
sof committed
716
717
718
719
720
721
722

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

723
724
725
726
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:

727
\begin{itemize}
728
729
730
\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
731
\end{itemize}
732
733

Why (b)?  Because if @Foo@ changes then this module's export list
734
735
736
737
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.

738
Why (c)?  Consider this:
739
740
741
742
743
\begin{verbatim}
	module A( f, g ) where	|	module B( f ) where
	  import B( f )		|	  f = h 3
	  g = ...		|	  h = ...
\end{verbatim}
744

745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
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> :: ... ;
769
770
771
772
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.
773

774
\begin{code}
775
776
777
778
779
mkImportInfo :: ModuleName			-- Name of this module
	     -> [ImportDecl n]			-- The import decls
	     -> RnMG [ImportVersion Name]

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

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

792
793
	mod_map   = iImpModInfo ifaces
	imp_names = iVSlurp     ifaces
794
	pit	  = iPIT 	ifaces
795

796
	-- mv_map groups together all the things imported from a particular module.
797
	mv_map :: ModuleEnv [Name]
798
	mv_map = foldr add_mv emptyModuleEnv imp_names
799

800
        add_mv name mv_map = addItem mv_map (nameModule name) name
801

802
	-- Build the result list by adding info for each module.
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
	-- 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.

818
	mk_imp_info mod_name (has_orphans, is_boot, opened) so_far
819
820
821
822
823
824
	   | 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
 
825
	   | not opened 		-- We didn't even open the interface
826
	   =		-- This happens when a module, Foo, that we explicitly imported has 
827
828
829
			-- '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
830
			-- file but we must still propagate the dependency info.
831
			-- The module in question must be a local module (in the same package)
832
833
	     go_for_it NothingAtAll

834

835
	   | is_lib_module && not has_orphans
836
	   = so_far		
837
	   
838
	   | is_lib_module 			-- Record the module version only
839
	   = go_for_it (Everything module_vers)
840

841
	   | otherwise
842
	   = go_for_it whats_imported
843
844
845
846
847
848
849
850

	     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
851
		module_vers	  = vers_module version_info
852

853
854
		whats_imported = Specifically module_vers
					      export_vers import_items 
855
856
857
					      (vers_rules version_info)

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

871

872
addItem :: ModuleEnv [a] -> Module -> a -> ModuleEnv [a]
873
addItem fm mod x = extendModuleEnv_C add_item fm mod [x]
874
875
		 where
		   add_item xs _ = x:xs
876
\end{code}
877

sof's avatar
sof committed
878
\begin{code}
879
getSlurped
sof's avatar
sof committed
880
  = getIfacesRn 	`thenRn` \ ifaces ->
881
    returnRn (iSlurp ifaces)
sof's avatar
sof committed
882

883
recordSlurp ifaces@(Ifaces { iSlurp = slurped_names, iVSlurp = imp_names })
884
	    avail
885
  = let
sof's avatar
sof committed
886
	new_slurped_names = addAvailToNameSet slurped_names avail
887
	new_imp_names     = availName avail : imp_names
888
889
    in
    ifaces { iSlurp  = new_slurped_names, iVSlurp = new_imp_names }
sof's avatar
sof committed
890

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


900
901
902
903
904
905
906
907
908
909
%*********************************************************
%*							*
\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@).

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

913
\begin{code}
914
getDeclBinders :: (RdrName -> SrcLoc -> RnM d Name)	-- New-name function
915
		-> RdrNameHsDecl
916
		-> RnM d (Maybe AvailInfo)
917

918
919
920
921
922
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
923
924
925

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

sof's avatar
sof committed
928
929
930
931
932
933
    -- 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))

934
935
  | otherwise 		-- a foreign export
  = lookupOrigName nm `thenRn_` 
sof's avatar
sof committed
936
937
    returnRn Nothing

938
939
940
941
942
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
943

sof's avatar
sof committed
944
945
binds_haskell_name (FoImport _) _   = True
binds_haskell_name FoLabel      _   = True
946
binds_haskell_name FoExport  ext_nm = isDynamicExtName ext_nm
947
948
\end{code}

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

954
955
956
957
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.

958
\begin{code}
959
getDeclSysBinders new_name (TyClD (ClassDecl _ cname _ _ sigs _ names src_loc))
960
  = sequenceRn [new_name n src_loc | n <- names]
961

962
getDeclSysBinders new_name (TyClD (TyData _ _ _ _ cons _ _ _ _ _))
963
  = sequenceRn [new_name wkr_name src_loc | ConDecl _ wkr_name _ _ _ src_loc <- cons]
964
965
966
967

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

969
970
971
972
973
974
%*********************************************************
%*							*
\subsection{Reading an interface file}
%*							*
%*********************************************************

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

983
findAndReadIface doc_str mod_name hi_boot_file
984
  = traceRn trace_msg			`thenRn_`
985
986
987
      -- 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.
988

989
990
    getFinderRn				`thenRn` \ finder ->
    ioToRnM (finder mod_name)		`thenRn` \ maybe_found ->
991

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

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

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