RnNames.lhs 35 KB
Newer Older
1
2
3
4
5
6
7
%
% (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
%
\section[RnNames]{Extracting imported and top-level names in scope}

\begin{code}
module RnNames (
8
	rnImports, importsFromLocalDecls, exportsFromAvail,
9
	reportUnusedNames, mkModDeps, exportsToAvails
10
11
12
13
    ) where

#include "HsVersions.h"

14
import CmdLineOpts	( DynFlag(..) )
15
import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
16
			  ForeignDecl(..), HsGroup(..),
17
			  collectGroupBinders, tyClDeclNames 
18
			)
19
import RnEnv
20
import IfaceEnv		( lookupOrig, newGlobalBinder )
21
import LoadIface	( loadSrcInterface )
22
import TcRnMonad
23
24

import FiniteMap
25
26
import PrelNames	( pRELUDE_Name, isBuiltInSyntaxName, isUnboundName,
			  main_RDR_Unqual )
27
import Module		( Module, ModuleName, moduleName, mkPackageModule,
28
			  moduleNameUserString, isHomeModule,
29
30
31
32
			  unitModuleEnvByName, unitModuleEnv, 
			  lookupModuleEnvByName, moduleEnvElts )
import Name		( Name, nameSrcLoc, nameOccName, nameModuleName,
			  nameParent, nameParent_maybe, isExternalName )
33
import NameSet
34
import NameEnv
35
import OccName		( OccName, srcDataName, isTcOcc )
36
37
38
39
import HscTypes		( GenAvailInfo(..), AvailInfo, Avails, GhciMode(..),
			  IsBootInterface, IfaceExport, 
			  availName, availNames, availsToNameSet, unQualInScope, 
			  Deprecs(..), ModIface(..), Dependencies(..)
40
			)
41
42
43
44
45
46
import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace, 
		  	  GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), 
			  emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
			  unQualOK, lookupGRE_Name,
			  Provenance(..), ImportSpec(..), 
			  isLocalGRE, pprNameProvenance )
47
import Outputable
48
import Maybes		( isJust, isNothing, catMaybes, mapCatMaybes )
49
import SrcLoc		( noSrcLoc, Located(..), mkGeneralSrcSpan,
50
			  unLoc, noLoc )
51
import ListSetOps	( removeDups )
sof's avatar
sof committed
52
import Util		( sortLt, notNull )
53
import List		( partition, insert )
54
import IO		( openFile, IOMode(..) )
55
56
57
58
59
60
\end{code}



%************************************************************************
%*									*
61
		rnImports
62
63
64
65
%*									*
%************************************************************************

\begin{code}
66
rnImports :: [LImportDecl RdrName]
67
	  -> RnM (GlobalRdrEnv, ImportAvails)
68
69
70

rnImports imports
  = 		-- PROCESS IMPORT DECLS
71
72
		-- Do the non {- SOURCE -} ones first, so that we get a helpful
		-- warning for {- SOURCE -} ones that are unnecessary
73
74
	getModule				`thenM` \ this_mod ->
	doptM Opt_NoImplicitPrelude		`thenM` \ opt_no_prelude -> 
75
	let
76
	  all_imports	     = mk_prel_imports this_mod opt_no_prelude ++ imports
77
	  (source, ordinary) = partition is_source_import all_imports
78
	  is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
79

80
	  get_imports = importsFromImportDecl this_mod
81
	in
82
83
	mappM get_imports ordinary	`thenM` \ stuff1 ->
	mappM get_imports source	`thenM` \ stuff2 ->
84
85
86

		-- COMBINE RESULTS
	let
87
	    (imp_gbl_envs, imp_avails) = unzip (stuff1 ++ stuff2)
88
	    gbl_env :: GlobalRdrEnv
89
	    gbl_env = foldr plusGlobalRdrEnv emptyGlobalRdrEnv imp_gbl_envs
90

91
92
	    all_avails :: ImportAvails
	    all_avails = foldr plusImportAvails emptyImportAvails imp_avails
93
	in
94
		-- ALL DONE
95
	returnM (gbl_env, all_avails)
96
97
  where
	-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
98
99
	-- because the former doesn't even look at Prelude.hi for instance 
	-- declarations, whereas the latter does.
100
    mk_prel_imports this_mod no_prelude
101
102
103
	|  moduleName this_mod == pRELUDE_Name
	|| explicit_prelude_import
	|| no_prelude
104
105
	= []

106
	| otherwise = [preludeImportDecl]
107

108
    explicit_prelude_import
109
110
      = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, 
		       unLoc mod == pRELUDE_Name ]
111

112
113
114
preludeImportDecl
  = L loc $
	ImportDecl (L loc pRELUDE_Name)
115
116
117
118
	       False {- Not a boot interface -}
	       False	{- Not qualified -}
	       Nothing	{- No "as" -}
	       Nothing	{- No import list -}
119
120
  where
    loc = mkGeneralSrcSpan FSLIT("Implicit import declaration")
121
122
123
\end{code}
	
\begin{code}
124
importsFromImportDecl :: Module
125
		      -> LImportDecl RdrName
126
		      -> RnM (GlobalRdrEnv, ImportAvails)
127

128
importsFromImportDecl this_mod
129
130
131
	(L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
  = 
    addSrcSpan loc $
132
133
134

	-- If there's an error in loadInterface, (e.g. interface
	-- file not found) we get lots of spurious errors from 'filterImports'
135
    let
136
	imp_mod_name = unLoc loc_imp_mod_name
137
	this_mod_name = moduleName this_mod
138
	doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
139
    in
140
    loadSrcInterface doc imp_mod_name want_boot	`thenM` \ iface ->
141

142
143
144
	-- Compiler sanity check: if the import didn't say
	-- {-# SOURCE #-} we should not get a hi-boot file
    WARN( not want_boot && mi_boot iface, ppr imp_mod_name )
145

146
147
148
149
150
	-- Issue a user warning for a redundant {- SOURCE -} import
	-- NB that we arrange to read all the ordinary imports before 
	-- any of the {- SOURCE -} imports
    warnIf (want_boot && not (mi_boot iface))
	   (warnRedundantSourceImport imp_mod_name)	`thenM_`
151

152
    let
153
154
155
156
157
158
159
	imp_mod	= mi_module iface
	deprecs	= mi_deprecs iface
	is_orph	= mi_orphan iface 
	deps 	= mi_deps iface

	filtered_exports = filter not_this_mod (mi_exports iface)
	not_this_mod (mod,_) = mod /= this_mod_name
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
	-- 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.)  
	--
	-- Tiresome 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.  Oh well.
176
    in
177
178
    exportsToAvails filtered_exports			`thenM` \ avails ->

179
	-- Filter the imports according to the import list
180
    filterImports imp_mod want_boot imp_details avails	`thenM` \ (filtered_avails, explicits) ->
181
182

    let
183
184
185
	-- Compute new transitive dependencies
 	orphans | is_orph   = insert imp_mod_name (dep_orphs deps)
		| otherwise = dep_orphs deps
186
187
188
189
190
191
192
193

	(dependent_mods, dependent_pkgs) 
	   | isHomeModule imp_mod 
	   = 	-- Imported module is from the home package
		-- Take its dependent modules and
		--	(a) remove this_mod (might be there as a hi-boot)
		--	(b) add imp_mod itself
		-- Take its dependent packages unchanged
194
	     ((imp_mod_name, want_boot) : filter not_self (dep_mods deps), dep_pkgs deps)
195

196
197
	   | otherwise	
 	   = 	-- Imported module is from another package
198
		-- Dump the dependent modules
199
200
		-- Add the package imp_mod comes from to the dependent packages
		-- from imp_mod
201
	     ([], insert (mi_package iface) (dep_pkgs deps))
202

203
	not_self (m, _) = m /= this_mod_name
204

205
206
207
208
	import_all = case imp_details of
			Just (is_hiding, ls)	 -- Imports are spec'd explicitly
			  | not is_hiding -> Just (not (null ls))
			_ -> Nothing		-- Everything is imported, 
sof's avatar
sof committed
209
						-- (or almost everything [hiding])
210
211
212
213

	qual_mod_name = case as_mod of
			  Nothing  	    -> imp_mod_name
			  Just another_name -> another_name
214
	
215
216
217
218
	-- unqual_avails is the Avails that are visible in *unqualified* form
	-- We need to know this so we know what to export when we see
	--	module M ( module P ) where ...
	-- Then we must export whatever came from P unqualified.
219
	imp_spec  = ImportSpec { is_mod = imp_mod_name, is_qual = qual_only,  
220
		  		 is_loc = loc, is_as = qual_mod_name }
221
222
223
224
225
226
227
	mk_deprec = mi_dep_fn iface
	gres	  = [ GRE { gre_name = name, 
		  	    gre_prov = Imported [imp_spec] (name `elemNameSet` explicits),
		  	    gre_deprec = mk_deprec name }
		  	| avail <- filtered_avails, name <- availNames avail ]
	gbl_env   = mkGlobalRdrEnv gres
		  
228
	avail_env = mkAvailEnv filtered_avails
229
	imports   = ImportAvails { 
230
231
232
233
234
235
			imp_qual     = unitModuleEnvByName qual_mod_name avail_env,
			imp_env      = avail_env,
			imp_mods     = unitModuleEnv imp_mod (imp_mod, import_all),
			imp_orphs    = orphans,
			imp_dep_mods = mkModDeps dependent_mods,
			imp_dep_pkgs = dependent_pkgs }
236

237
    in
238
	-- Complain if we import a deprecated module
239
    ifOptM Opt_WarnDeprecations	(
240
       case deprecs of	
241
242
243
	  DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
	  other	        -> returnM ()
    )							`thenM_`
244

245
    returnM (gbl_env, imports)
246

247
248
249
250
251
252
exportsToAvails :: [IfaceExport] -> TcRnIf gbl lcl Avails
exportsToAvails exports 
  = do 	{ avails_by_module <- mappM do_one exports
	; return (concat avails_by_module) }
  where
    do_one (mod_name, exports) = mapM (do_avail mod_name) exports
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
    do_avail mod_nm (Avail n)      = do { n' <- lookupOrig mod_nm n; 
					; return (Avail n') }
    do_avail mod_nm (AvailTC n ns) = do { n' <- lookupOrig mod_nm n
					; ns' <- mappM (lookup_sub n') ns
					; return (AvailTC n' ns') }
	where
	  mod = mkPackageModule mod_nm	-- Not necessarily right yet
	  lookup_sub parent occ = newGlobalBinder mod occ (Just parent) noSrcLoc
		-- Hack alert! Notice the newGlobalBinder.  It ensures that the subordinate 
		-- names record their parent; and that in turn ensures that the GlobalRdrEnv
		-- has the correct parent for all the names in its range.
		-- For imported things, we only suck in the binding site later, if ever.
	-- Reason for all this:
	--   Suppose module M exports type A.T, and constructor A.MkT
	--   Then, we know that A.MkT is a subordinate name of A.T,
	--   even though we aren't at the binding site of A.T
	--   And it's important, because we may simply re-export A.T
	--   without ever sucking in the declaration itself.
271
272
273
274

warnRedundantSourceImport mod_name
  = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
          <+> quotes (ppr mod_name)
275
276
277
\end{code}


278
279
280
281
282
283
284
285
286
287
288
289
290
%************************************************************************
%*									*
		importsFromLocalDecls
%*									*
%************************************************************************

From the top-level declarations of this module produce
  	* the lexical environment
	* the ImportAvails
created by its bindings.  
	
Complain about duplicate bindings

291
\begin{code}
292
importsFromLocalDecls :: HsGroup RdrName
293
		      -> RnM (GlobalRdrEnv, ImportAvails)
294
295
296
importsFromLocalDecls group
  = getModule				`thenM` \ this_mod ->
    getLocalDeclBinders this_mod group	`thenM` \ avails ->
297
	-- The avails that are returned don't include the "system" names
298
299
300
301
302
    let
	all_names :: [Name]	-- All the defns; no dups eliminated
	all_names = [name | avail <- avails, name <- availNames avail]

	dups :: [[Name]]
303
	(_, dups) = removeDups compare all_names
304
305
    in
	-- Check for duplicate definitions
306
307
308
	-- The complaint will come out as "Multiple declarations of Foo.f" because
	-- since 'f' is in the env twice, the unQualInScope used by the error-msg
	-- printer returns False.  It seems awkward to fix, unfortunately.
309
    mappM_ (addErr . dupDeclErr) dups			`thenM_` 
310

311
    doptM Opt_NoImplicitPrelude 		`thenM` \ implicit_prelude ->
312
    let
313
314
315
316
317
318
	mod_name = moduleName this_mod
	prov     = LocalDef mod_name
	gbl_env  = mkGlobalRdrEnv gres
	gres     = [ GRE { gre_name = name, gre_prov = prov, gre_deprec = Nothing}
		   | name <- all_names]
	    -- gre_deprecs = Nothing: don't deprecate locally defined names
319
320
321
322
323
324
	    -- For a start, we may be exporting a deprecated thing
	    -- Also we may use a deprecated thing in the defn of another
	    -- deprecated things.  We may even use a deprecated thing in
	    -- the defn of a non-deprecated thing, when changing a module's 
	    -- interface

325
326
327
328

	    -- Optimisation: filter out names for built-in syntax
	    -- They just clutter up the environment (esp tuples), and the parser
	    -- will generate Exact RdrNames for them, so the cluttered
329
	    -- envt is no use.  To avoid doing this filter all the time,
330
	    -- we use -fno-implicit-prelude as a clue that the filter is
331
	    -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
332
333
334
335
336
337
338
339
	    --
	    -- It's worth doing because it makes the environment smaller for
	    -- every module that imports the Prelude
	    --
	    -- Note: don't filter the gbl_env (hence avails, not avails' in
	    -- defn of gbl_env above).      Stupid reason: when parsing 
	    -- data type decls, the constructors start as Exact tycon-names,
	    -- and then get turned into data con names by zapping the name space;
340
341
342
	    -- but that stops them being Exact, so they get looked up.  
	    -- Ditto in fixity decls; e.g. 	infix 5 :
	    -- Sigh. It doesn't matter because it only affects the Data.Tuple really.
343
	    -- The important thing is to trim down the exports.
344

345
346
347
348
349
 	avails' | implicit_prelude = filter not_built_in_syntax avails
		| otherwise	   = avails
	not_built_in_syntax a = not (all isBuiltInSyntaxName (availNames a))
		-- Only filter it if all the names of the avail are built-in
		-- In particular, lists have (:) which is not built in syntax
350
		-- so we don't filter it out.  [Sept 03: wrong: see isBuiltInSyntaxName]
351
352
353

	avail_env = mkAvailEnv avails'
	imports   = emptyImportAvails {
354
355
			imp_qual = unitModuleEnv this_mod avail_env,
			imp_env  = avail_env
356
		    }
357
    in
358
359
360
361
362
363
364
365
366
367
    returnM (gbl_env, imports)
\end{code}


%*********************************************************
%*							*
\subsection{Getting binders out of a declaration}
%*							*
%*********************************************************

368
369
@getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
used for source code.
370

371
372
373
	*** See "THE NAMING STORY" in HsDecls ****

\begin{code}
374
getLocalDeclBinders :: Module -> HsGroup RdrName -> RnM [AvailInfo]
375
376
377
getLocalDeclBinders mod (HsGroup {hs_valds = val_decls, 
				  hs_tyclds = tycl_decls, 
				  hs_fords = foreign_decls })
378
379
380
381
  =	-- For type and class decls, we generate Global names, with
	-- no export indicator.  They need to be global because they get
	-- permanently bound into the TyCons and Classes.  They don't need
	-- an export indicator because they are all implicitly exported.
382

383
384
385
    mappM new_tc     tycl_decls				`thenM` \ tc_avails ->
    mappM new_simple (for_hs_bndrs ++ val_hs_bndrs)	`thenM` \ simple_avails ->
    returnM (tc_avails ++ simple_avails)
386
  where
387
388
    new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name `thenM` \ name ->
			  returnM (Avail name)
389

390
391
    val_hs_bndrs = collectGroupBinders val_decls
    for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]
392

393
394
395
396
397
    new_tc tc_decl 
	= newTopSrcBinder mod Nothing main_rdr			`thenM` \ main_name ->
	  mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs	`thenM` \ sub_names ->
	  returnM (AvailTC main_name (main_name : sub_names))
	where
398
	  (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
399
400
\end{code}

401

402
403
404
405
406
407
408
409
410
411
%************************************************************************
%*									*
\subsection{Filtering imports}
%*									*
%************************************************************************

@filterImports@ takes the @ExportEnv@ telling what the imported module makes
available, and filters it through the import spec (if any).

\begin{code}
412
filterImports :: Module				-- The module being imported
413
	      -> IsBootInterface		-- Tells whether it's a {-# SOURCE #-} import
414
	      -> Maybe (Bool, [Located (IE RdrName)])	-- Import spec; True => hiding
415
	      -> [AvailInfo]			-- What's available
416
	      -> RnM ([AvailInfo],		-- What's imported
417
418
419
420
		       NameSet)			-- What was imported explicitly

	-- Complains if import spec mentions things that the module doesn't export
        -- Warns/informs if import spec contains duplicates.
421
filterImports mod from Nothing imports
422
  = returnM (imports, emptyNameSet)
423

424
filterImports mod from (Just (want_hiding, import_items)) total_avails
425
  = mappM (addLocM get_item) import_items 	`thenM` \ avails_w_explicits_s ->
426
    let
427
	(item_avails, explicits_s) = unzip (concat avails_w_explicits_s)
428
429
	explicits		   = foldl addListToNameSet emptyNameSet explicits_s
    in
430
431
432
433
434
    if want_hiding then
	let	-- All imported; item_avails to be hidden
	   hidden = availsToNameSet item_avails
	   keep n = not (n `elemNameSet` hidden)
  	in
435
	returnM (pruneAvails keep total_avails, emptyNameSet)
436
437
    else
	-- Just item_avails imported; nothing to be hidden
438
	returnM (item_avails, explicits)
439
440
441
  where
    import_fm :: FiniteMap OccName AvailInfo
    import_fm = listToFM [ (nameOccName name, avail) 
442
			 | avail <- total_avails,
443
444
445
446
447
			   name  <- availNames avail]
	-- Even though availNames returns data constructors too,
	-- they won't make any difference because naked entities like T
	-- in an import list map to TcOccs, not VarOccs.

448
449
    bale_out item = addErr (badImportItemErr mod from item)	`thenM_`
		    returnM []
450

451
    get_item :: IE RdrName -> RnM [(AvailInfo, [Name])]
452
453
454
455
456
	-- Empty list for a bad item.
	-- Singleton is typical case.
	-- Can have two when we are hiding, and mention C which might be
	--	both a class and a data constructor.  
	-- The [Name] is the list of explicitly-mentioned names
457
458
    get_item item@(IEModuleContents _) = bale_out item

459
    get_item item@(IEThingAll tc)
460
461
462
463
464
      = case check_item item of
	  Nothing    		     -> bale_out item
	  Just avail@(AvailTC _ [n]) -> 	-- This occurs when you import T(..), but
						-- only export T abstractly.  The single [n]
						-- in the AvailTC is the type or class itself
465
					ifOptM Opt_WarnMisc (addWarn (dodgyImportWarn mod tc))	`thenM_`
466
467
		     	 		returnM [(avail, [availName avail])]
	  Just avail 		     -> returnM [(avail, [availName avail])]
468
469
470
471

    get_item item@(IEThingAbs n)
      | want_hiding	-- hiding( C ) 
			-- Here the 'C' can be a data constructor *or* a type/class
472
      = case catMaybes [check_item item, check_item (IEVar data_n)] of
473
		[]     -> bale_out item
474
		avails -> returnM [(a, []) | a <- avails]
475
476
				-- The 'explicits' list is irrelevant when hiding
      where
477
	data_n = setRdrNameSpace n srcDataName
478
479
480
481

    get_item item
      = case check_item item of
	  Nothing    -> bale_out item
482
	  Just avail -> returnM [(avail, availNames avail)]
483

484
    check_item item
485
486
      | isNothing maybe_in_import_avails ||
	isNothing maybe_filtered_avail
487
      = Nothing
488

489
      | otherwise    
490
      = Just filtered_avail
491
492
493
494
495
496
497
498
499
500
501
		
      where
 	wanted_occ	       = rdrNameOcc (ieName item)
	maybe_in_import_avails = lookupFM import_fm wanted_occ

	Just avail	       = maybe_in_import_avails
	maybe_filtered_avail   = filterAvail item avail
	Just filtered_avail    = maybe_filtered_avail
\end{code}

\begin{code}
502
filterAvail :: IE RdrName	-- Wanted
503
504
505
506
507
508
509
	    -> AvailInfo	-- Available
	    -> Maybe AvailInfo	-- Resulting available; 
				-- Nothing if (any of the) wanted stuff isn't there

filterAvail ie@(IEThingWith want wants) avail@(AvailTC n ns)
  | sub_names_ok = Just (AvailTC n (filter is_wanted ns))
  | otherwise    = Nothing
510
  where
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
    is_wanted name = nameOccName name `elem` wanted_occs
    sub_names_ok   = all (`elem` avail_occs) wanted_occs
    avail_occs	   = map nameOccName ns
    wanted_occs    = map rdrNameOcc (want:wants)

filterAvail (IEThingAbs _) (AvailTC n ns)       = ASSERT( n `elem` ns ) 
						  Just (AvailTC n [n])

filterAvail (IEThingAbs _) avail@(Avail n)      = Just avail		-- Type synonyms

filterAvail (IEVar _)      avail@(Avail n)      = Just avail
filterAvail (IEVar v)      avail@(AvailTC n ns) = Just (AvailTC n (filter wanted ns))
						where
						  wanted n = nameOccName n == occ
						  occ      = rdrNameOcc v
	-- The second equation happens if we import a class op, thus
	-- 	import A( op ) 
	-- where op is a class operation

filterAvail (IEThingAll _) avail@(AvailTC _ _)   = Just avail
	-- We don't complain even if the IE says T(..), but
	-- no constrs/class ops of T are available
	-- Instead that's caught with a warning by the caller

filterAvail ie avail = Nothing
536
537
538
539
540
\end{code}


%************************************************************************
%*									*
541
\subsection{Export list processing}
542
543
544
545
546
%*									*
%************************************************************************

Processing the export list.

547
548
549
550
551
You might think that we should record things that appear in the export
list as ``occurrences'' (using @addOccurrenceName@), but you'd be
wrong.  We do check (here) that they are in scope, but there is no
need to slurp in their actual declaration (which is what
@addOccurrenceName@ forces).
552

553
554
555
Indeed, doing so would big trouble when compiling @PrelBase@, because
it re-exports @GHC@, which includes @takeMVar#@, whose type includes
@ConcBase.StateAndSynchVar#@, and so on...
556
557
558
559
560
561

\begin{code}
type ExportAccum	-- The type of the accumulating parameter of
			-- the main worker function in exportsFromAvail
     = ([ModuleName], 		-- 'module M's seen so far
	ExportOccMap,		-- Tracks exported occurrence names
562
	AvailEnv)		-- The accumulated exported stuff, kept in an env
563
				--   so we can common-up related AvailInfos
564
emptyExportAccum = ([], emptyFM, emptyAvailEnv) 
565

566
type ExportOccMap = FiniteMap OccName (Name, IE RdrName)
567
568
569
570
571
572
	-- Tracks what a particular exported OccName
	--   in an export list refers to, and which item
	--   it came from.  It's illegal to export two distinct things
	--   that have the same occurrence name


573
574
exportsFromAvail :: Bool  -- False => no 'module M(..) where' header at all
		 -> Maybe [Located (IE RdrName)] -- Nothing => no explicit export list
575
		 -> RnM Avails
576
577
578
	-- Complains if two distinct exports have same OccName
        -- Warns about identical exports.
	-- Complains about exports items not in scope
579

580
exportsFromAvail explicit_mod exports
581
582
 = do { TcGblEnv { tcg_rdr_env = rdr_env, 
		   tcg_imports = imports } <- getGblEnv ;
583
584
585
586
587
588
589
590
591

	-- If the module header is omitted altogether, then behave
	-- as if the user had written "module Main(main) where..."
	-- EXCEPT in interactive mode, when we behave as if he had
	-- written "module Main where ..."
	-- Reason: don't want to complain about 'main' not in scope
	--	   in interactive mode
	ghci_mode <- getGhciMode ;
	let { real_exports 
592
593
594
		| explicit_mod   	   = exports
		| ghci_mode == Interactive = Nothing
		| otherwise 		   = Just [noLoc (IEVar main_RDR_Unqual)] } ;
595
	exports_from_avail real_exports rdr_env imports }
596

597

598
exports_from_avail Nothing rdr_env
599
		   imports@(ImportAvails { imp_env = entity_avail_env })
600
601
602
603
604
605
 =  	-- Export all locally-defined things
	-- We do this by filtering the global RdrEnv,
	-- keeping only things that are (a) qualified,
	-- (b) locally defined, (c) a 'main' name
	-- Then we look up in the entity-avail-env
   return [ lookupAvailEnv entity_avail_env name
606
607
608
609
610
	  | gre <- globalRdrEnvElts rdr_env,
	    isLocalGRE gre,
	    let name = gre_name gre,
	    isNothing (nameParent_maybe name)	-- Main things only
	  ]
611

612
exports_from_avail (Just export_items) rdr_env
613
614
		   (ImportAvails { imp_qual = mod_avail_env, 
				   imp_env  = entity_avail_env }) 
615
  = foldlM (exports_from_litem) emptyExportAccum
616
617
	    export_items			`thenM` \ (_, _, export_avail_map) ->
    returnM (nameEnvElts export_avail_map)
618
619

  where
620
621
    exports_from_litem :: ExportAccum -> Located (IE RdrName) -> RnM ExportAccum
    exports_from_litem acc = addLocM (exports_from_item acc)
622

623
    exports_from_item :: ExportAccum -> IE RdrName -> RnM ExportAccum
624
    exports_from_item acc@(mods, occs, avails) ie@(IEModuleContents mod)
625
	| mod `elem` mods 	-- Duplicate export of M
626
627
628
	= do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
	       warnIf warn_dup_exports (dupModuleExport mod) ;
	       returnM acc }
629
630

	| otherwise
631
	= case lookupModuleEnvByName mod_avail_env mod of
632
633
634
	    Nothing -> addErr (modExportErr mod)	`thenM_`
		       returnM acc

635
	    Just avail_env
636
		-> let
637
638
			mod_avails = [ filtered_avail
				     | avail <- availEnvElts avail_env,
639
				       let mb_avail = filter_unqual rdr_env avail,
640
641
642
				       isJust mb_avail,
				       let Just filtered_avail = mb_avail]
						
643
644
			avails' = foldl addAvail avails mod_avails
		   in
645
646
647
648
		-- This check_occs not only finds conflicts between this item
		-- and others, but also internally within this item.  That is,
		-- if 'M.x' is in scope in several ways, we'll have several
		-- members of mod_avails with the same OccName.
649

650
		   foldlM (check_occs ie) occs mod_avails	`thenM` \ occs' ->
651
652
653
		   returnM (mod:mods, occs', avails')

    exports_from_item acc@(mods, occs, avails) ie
654
655
656
657
	= lookupGlobalOccRn (ieName ie)	 		`thenM` \ name -> 
	  if isUnboundName name then
		returnM acc 	-- Avoid error cascade
	  else
658
		-- Get the AvailInfo for the parent of the specified name
659
	  let
660
	    parent = nameParent name 
661
	    avail  = lookupAvailEnv entity_avail_env parent
662
	  in
663
664
665
		-- Filter out the bits we want
	  case filterAvail ie avail of {
	    Nothing -> 	-- Not enough availability
666
667
			addErr (exportItemErr ie) `thenM_`
			returnM acc ;
668

669
	    Just export_avail -> 	
670

671
		-- Phew!  It's OK!  Now to check the occurrence stuff!
672
	  checkForDodgyExport ie avail				`thenM_`
673
          check_occs ie occs export_avail			`thenM` \ occs' ->
674
	  returnM (mods, occs', addAvail avails export_avail)
675
	  }
676
677


678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
-------------------------------
filter_unqual :: GlobalRdrEnv -> AvailInfo -> Maybe AvailInfo
-- Filter the Avail by what's in scope unqualified
filter_unqual env (Avail n)
  | in_scope env n = Just (Avail n)
  | otherwise	   = Nothing
filter_unqual env (AvailTC n ns)
  | not (null ns') = Just (AvailTC n ns')
  | otherwise	   = Nothing
  where
    ns' = filter (in_scope env) ns

in_scope :: GlobalRdrEnv -> Name -> Bool
-- Checks whether the Name is in scope unqualified, 
-- regardless of whether it's ambiguous or not
693
in_scope env n = any unQualOK (lookupGRE_Name env n)
694

695
-------------------------------
696
697
checkForDodgyExport :: IE RdrName -> AvailInfo -> RnM ()
checkForDodgyExport (IEThingAll tc) (AvailTC _ [n]) = addWarn (dodgyExportWarn tc)
698
699
700
  -- This occurs when you import T(..), but
  -- only export T abstractly.  The single [n]
  -- in the AvailTC is the type or class itself
701
checkForDodgyExport _ _ = return ()
702

703
-------------------------------
704
check_occs :: IE RdrName -> ExportOccMap -> AvailInfo -> RnM ExportOccMap
705
check_occs ie occs avail 
706
  = foldlM check occs (availNames avail)
707
  where
708
    check occs name
709
      = case lookupFM occs name_occ of
710
711
	  Nothing -> returnM (addToFM occs name_occ (name, ie))

712
	  Just (name', ie') 
713
714
715
716
717
718
719
720
721
	    | name == name'  	-- Duplicate export
	    ->	do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
		     warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
		     returnM occs }

	    | otherwise		-- Same occ name but different names: an error
	    ->	do { global_env <- getGlobalRdrEnv ;
  		     addErr (exportClashErr global_env name name' ie ie') ;
		     returnM occs }
722
723
724
725
      where
	name_occ = nameOccName name
\end{code}

726
727
728
729
730
731
732
%*********************************************************
%*						 	 *
\subsection{Unused names}
%*							 *
%*********************************************************

\begin{code}
733
734
reportUnusedNames :: TcGblEnv -> RnM ()
reportUnusedNames gbl_env 
735
736
737
  = warnUnusedModules unused_imp_mods	`thenM_`
    warnUnusedTopBinds bad_locals	`thenM_`
    warnUnusedImports bad_imports	`thenM_`
738
739
    printMinimalImports minimal_imports
  where
740
741
742
743
744
745
    used_names, all_used_names :: NameSet
    used_names = findUses (tcg_dus gbl_env) emptyNameSet
    all_used_names = used_names `unionNameSets` 
		     mkNameSet (mapCatMaybes nameParent_maybe (nameSetToList used_names))
			-- A use of C implies a use of T,
			-- if C was brought into scope by T(..) or T(C)
746
747
748

	-- Collect the defined names from the in-scope environment
    defined_names :: [GlobalRdrElt]
749
    defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
750
751

    defined_and_used, defined_but_not_used :: [GlobalRdrElt]
752
753
    (defined_and_used, defined_but_not_used) = partition is_used defined_names

754
    is_used gre = gre_name gre `elemNameSet` all_used_names
755
    
756
757
758
759
    -- Filter out the ones that are 
    --  (a) defined in this module, and
    --	(b) not defined by a 'deriving' clause 
    -- The latter have an Internal Name, so we can filter them out easily
760
    bad_locals :: [GlobalRdrElt]
761
762
763
    bad_locals = filter is_bad defined_but_not_used
    is_bad :: GlobalRdrElt -> Bool
    is_bad gre = isLocalGRE gre && isExternalName (gre_name gre)
764
765
766
    
    bad_imports :: [GlobalRdrElt]
    bad_imports = filter bad_imp defined_but_not_used
767
768
769
770
771
    bad_imp (GRE {gre_prov = Imported imp_specs True}) 
	= not (all (module_unused . is_mod) imp_specs)
		-- Don't complain about unused imports if we've already said the
		-- entire import is unused
    bad_imp other = False
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
    
    -- To figure out the minimal set of imports, start with the things
    -- that are in scope (i.e. in gbl_env).  Then just combine them
    -- into a bunch of avails, so they are properly grouped
    minimal_imports :: FiniteMap ModuleName AvailEnv
    minimal_imports0 = emptyFM
    minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
    minimal_imports  = foldr add_inst_mod minimal_imports1 direct_import_mods
 	-- The last line makes sure that we retain all direct imports
    	-- even if we import nothing explicitly.
    	-- It's not necessarily redundant to import such modules. Consider 
    	--	      module This
    	--		import M ()
    	--
    	-- The import M() is not *necessarily* redundant, even if
    	-- we suck in no instance decls from M (e.g. it contains 
    	-- no instance decls, or This contains no code).  It may be 
    	-- that we import M solely to ensure that M's orphan instance 
    	-- decls (or those in its imports) are visible to people who 
    	-- import This.  Sigh. 
    	-- There's really no good way to detect this, so the error message 
    	-- in RnEnv.warnUnusedModules is weakened instead
    

	-- We've carefully preserved the provenance so that we can
	-- construct minimal imports that import the name by (one of)
	-- the same route(s) as the programmer originally did.
799
800
801
802
    add_name (GRE {gre_name = n, 
		   gre_prov = Imported imp_specs _}) acc 
	= addToFM_C plusAvailEnv acc (is_mod (head imp_specs))
		    (unitAvailEnv (mk_avail n (nameParent_maybe n)))
803
804
805
806
    add_name other acc 
	= acc

	-- n is the name of the thing, p is the name of its parent
807
808
809
    mk_avail n (Just p)			 	 = AvailTC p [p,n]
    mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n]
		       | otherwise		 = Avail n
810
811
812
813
814
815
816
    
    add_inst_mod m acc 
      | m `elemFM` acc = acc	-- We import something already
      | otherwise      = addToFM acc m emptyAvailEnv
    	-- Add an empty collection of imports for a module
    	-- from which we have sucked only instance decls
   
817
    imports = tcg_imports gbl_env
818
819
820
821
822

    direct_import_mods :: [ModuleName]
    direct_import_mods = map (moduleName . fst) 
			     (moduleEnvElts (imp_mods imports))

sof's avatar
sof committed
823
824
825
826
827
828
    hasEmptyImpList :: ModuleName -> Bool
    hasEmptyImpList m = 
       case lookupModuleEnvByName (imp_mods imports) m of
	 Just (_,Just x) -> not x
	 _ -> False

829
    -- unused_imp_mods are the directly-imported modules 
830
    -- that are not mentioned in minimal_imports1
831
    -- [Note: not 'minimal_imports', because that includes directly-imported
832
    --	      modules even if we use nothing from them; see notes above]
833
    unused_imp_mods = [m | m <- direct_import_mods,
834
    		       isNothing (lookupFM minimal_imports1 m),
sof's avatar
sof committed
835
836
    		       m /= pRELUDE_Name,
		       not (hasEmptyImpList m)]
837
838
839
840
841
842
	-- hasEmptyImpList arranges not to complain about
	-- import M (), which is an idiom for importing
	-- instance declarations
    
    module_unused :: ModuleName -> Bool
    module_unused mod = mod `elem` unused_imp_mods
843
844
845
846


-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
printMinimalImports :: FiniteMap ModuleName AvailEnv	-- Minimal imports
847
		    -> RnM ()
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
printMinimalImports imps
 = ifOptM Opt_D_dump_minimal_imports $ do {

   mod_ies  <-  mappM to_ies (fmToList imps) ;
   this_mod <- getModule ;
   rdr_env  <- getGlobalRdrEnv ;
   ioToTcRn (do { h <- openFile (mkFilename this_mod) WriteMode ;
		  printForUser h (unQualInScope rdr_env) 
				 (vcat (map ppr_mod_ie mod_ies)) })
   }
  where
    mkFilename this_mod = moduleNameUserString (moduleName this_mod) ++ ".imports"
    ppr_mod_ie (mod_name, ies) 
	| mod_name == pRELUDE_Name 
	= empty
863
864
	| null ies	-- Nothing except instances comes from here
	= ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("()    -- Instances only")
865
866
	| otherwise
	= ptext SLIT("import") <+> ppr mod_name <> 
867
		    parens (fsep (punctuate comma (map ppr ies)))
868
869
870
871

    to_ies (mod, avail_env) = mappM to_ie (availEnvElts avail_env)	`thenM` \ ies ->
			      returnM (mod, ies)

872
    to_ie :: AvailInfo -> RnM (IE Name)
873
874
875
876
877
878
879
	-- The main trick here is that if we're importing all the constructors
	-- we want to say "T(..)", but if we're importing only a subset we want
	-- to say "T(A,B,C)".  So we have to find out what the module exports.
    to_ie (Avail n)       = returnM (IEVar n)
    to_ie (AvailTC n [m]) = ASSERT( n==m ) 
			    returnM (IEThingAbs n)
    to_ie (AvailTC n ns)  
880
	= loadSrcInterface doc n_mod False			`thenM` \ iface ->
881
882
883
	  case [xs | (m,as) <- mi_exports iface,
		     m == n_mod,
		     AvailTC x xs <- as, 
884
885
886
887
888
		     x == nameOccName n] of
	      [xs] | all_used xs -> returnM (IEThingAll n)
		   | otherwise	 -> returnM (IEThingWith n (filter (/= n) ns))
	      other		 -> pprTrace "to_ie" (ppr n <+> ppr n_mod <+> ppr other) $
				    returnM (IEVar n)
889
	where
890
891
892
	  all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
	  doc = text "Compute minimal imports from" <+> ppr n
	  n_mod = nameModuleName n
893
894
895
\end{code}


896
897
898
899
900
901
902
%************************************************************************
%*									*
\subsection{Errors}
%*									*
%************************************************************************

\begin{code}
903
904
badImportItemErr mod from ie
  = sep [ptext SLIT("Module"), quotes (ppr mod), source_import,
905
	 ptext SLIT("does not export"), quotes (ppr ie)]
906
907
  where
    source_import = case from of
908
909
		      True  -> ptext SLIT("(hi-boot interface)")
		      other -> empty
910

911
912
dodgyImportWarn mod item = dodgyMsg (ptext SLIT("import")) item
dodgyExportWarn     item = dodgyMsg (ptext SLIT("export")) item
913

914
915
dodgyMsg kind tc
  = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr (IEThingAll tc)),
916
917
918
	  ptext SLIT("suggests that") <+> quotes (ppr tc) <+> ptext SLIT("has constructor or class methods"),
	  ptext SLIT("but it has none; it is a type synonym or abstract type or class") ]
	  
919
modExportErr mod
920
  = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (ppr mod)]
921
922

exportItemErr export_item
923
924
  = sep [ ptext SLIT("The export item") <+> quotes (ppr export_item),
	  ptext SLIT("attempts to export constructors or class methods that are not visible here") ]
925

926
927
928
929
exportClashErr global_env name1 name2 ie1 ie2
  = vcat [ ptext SLIT("Conflicting exports for") <+> quotes (ppr occ) <> colon
	 , ppr_export ie1 name1 
	 , ppr_export ie2 name2  ]
930
  where
931
932
933
934
    occ = nameOccName name1
    ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+> 
			 	 quotes (ppr name) <+> pprNameProvenance (get_gre name))

935
	-- get_gre finds a GRE for the Name, so that we can show its provenance
936
    get_gre name
937
	= case lookupGRE_Name global_env name of
938
939
	     (gre:_) -> gre
	     []	     -> pprPanic "exportClashErr" (ppr name)
940
941
942

dupDeclErr (n:ns)
  = vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr n),
943
	  nest 4 (vcat (map ppr sorted_locs))]
944
  where
945
946
    sorted_locs = sortLt occ'ed_before (map nameSrcLoc (n:ns))
    occ'ed_before a b = LT == compare a b
947
948
949
950
951
952
953
954

dupExportWarn occ_name ie1 ie2
  = hsep [quotes (ppr occ_name), 
          ptext SLIT("is exported by"), quotes (ppr ie1),
          ptext SLIT("and"),            quotes (ppr ie2)]

dupModuleExport mod
  = hsep [ptext SLIT("Duplicate"),
955
	  quotes (ptext SLIT("Module") <+> ppr mod), 
956
          ptext SLIT("in export list")]
957
958
959
960

moduleDeprec mod txt
  = sep [ ptext SLIT("Module") <+> quotes (ppr mod) <+> ptext SLIT("is deprecated:"), 
	  nest 4 (ppr txt) ]	  
961
\end{code}