RnNames.lhs 45.4 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
9
	rnImports, mkRdrEnvAndImports, importsFromLocalDecls,
	rnExports, mkExportNameSet,
10
	getLocalDeclBinders, extendRdrEnvRn,
11
	reportUnusedNames, reportDeprecations
12
13
14
15
    ) where

#include "HsVersions.h"

16
import DynFlags		( DynFlag(..), GhcMode(..) )
17
import HsSyn		( IE(..), ieName, ImportDecl(..), LImportDecl,
18
			  ForeignDecl(..), HsGroup(..), HsValBinds(..),
19
20
			  Sig(..), collectHsBindLocatedBinders, tyClDeclNames,
			  LIE )
21
import RnEnv
22
import IfaceEnv		( ifaceExportNames )
23
import LoadIface	( loadSrcInterface )
24
import TcRnMonad hiding (LIE)
25
26

import FiniteMap
27
import PrelNames	( pRELUDE, isUnboundName, main_RDR_Unqual )
28
import Module		( Module, moduleString, unitModuleEnv, 
29
			  lookupModuleEnv, moduleEnvElts, foldModuleEnv )
30
31
import Name		( Name, nameSrcLoc, nameOccName, nameModule, isWiredInName,
			  nameParent, nameParent_maybe, isExternalName,
32
			  isBuiltInSyntax )
33
import NameSet
34
import NameEnv
35
36
37
38
import OccName		( srcDataName, isTcOcc, pprNonVarNameSpace,
			  occNameSpace,
			  OccEnv, mkOccEnv, lookupOccEnv, emptyOccEnv,
			  extendOccEnv )
39
import HscTypes		( GenAvailInfo(..), AvailInfo,
40
			  HomePackageTable, PackageIfaceTable, 
41
			  unQualInScope, 
42
			  Deprecs(..), ModIface(..), Dependencies(..), 
43
			  lookupIface, ExternalPackageState(..)
44
			)
45
import Packages		( PackageIdH(..) )
46
47
48
import RdrName		( RdrName, rdrNameOcc, setRdrNameSpace, 
		  	  GlobalRdrEnv, mkGlobalRdrEnv, GlobalRdrElt(..), 
			  emptyGlobalRdrEnv, plusGlobalRdrEnv, globalRdrEnvElts,
49
			  extendGlobalRdrEnv, lookupGlobalRdrEnv, unQualOK, lookupGRE_Name,
50
51
			  Provenance(..), ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..), 
			  importSpecLoc, importSpecModule, isLocalGRE, pprNameProvenance )
52
import Outputable
53
import Maybes		( isNothing, catMaybes, mapCatMaybes, seqMaybe, orElse )
54
import SrcLoc		( Located(..), mkGeneralSrcSpan,
55
			  unLoc, noLoc, srcLocSpan, SrcSpan )
56
import BasicTypes	( DeprecTxt )
57
import DriverPhases	( isHsBoot )
58
import Util		( notNull )
59
import List		( partition )
60
import IO		( openFile, IOMode(..) )
61
62
63
64
65
66
\end{code}



%************************************************************************
%*									*
67
		rnImports
68
69
70
71
%*									*
%************************************************************************

\begin{code}
72
rnImports :: [LImportDecl RdrName] -> RnM [LImportDecl Name]
73
rnImports imports
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
         -- PROCESS IMPORT DECLS
         -- Do the non {- SOURCE -} ones first, so that we get a helpful
         -- warning for {- SOURCE -} ones that are unnecessary
    = do this_mod <- getModule
         implicit_prelude <- doptM Opt_ImplicitPrelude
         let all_imports	       = mk_prel_imports this_mod implicit_prelude ++ imports
             (source, ordinary) = partition is_source_import all_imports
             is_source_import (L _ (ImportDecl _ is_boot _ _ _)) = is_boot
             get_imports = importsFromImportDeclDirect this_mod

         stuff1 <- mapM get_imports ordinary
         stuff2 <- mapM get_imports source
         return (stuff1 ++ stuff2)
    where
-- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
-- because the former doesn't even look at Prelude.hi for instance 
-- declarations, whereas the latter does.
   mk_prel_imports this_mod implicit_prelude
       |  this_mod == pRELUDE
          || explicit_prelude_import
          || not implicit_prelude
           = []
       | otherwise = [preludeImportDecl]
   explicit_prelude_import
       = notNull [ () | L _ (ImportDecl mod _ _ _ _) <- imports, 
	           unLoc mod == pRELUDE ]

preludeImportDecl :: LImportDecl RdrName
102
103
preludeImportDecl
  = L loc $
104
	ImportDecl (L loc pRELUDE)
105
106
107
108
	       False {- Not a boot interface -}
	       False	{- Not qualified -}
	       Nothing	{- No "as" -}
	       Nothing	{- No import list -}
109
  where
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
    loc = mkGeneralSrcSpan FSLIT("Implicit import declaration")         

mkRdrEnvAndImports :: [LImportDecl Name] -> RnM (GlobalRdrEnv, ImportAvails)
mkRdrEnvAndImports imports
  = do this_mod <- getModule
       let get_imports = importsFromImportDecl this_mod
       stuff <- mapM get_imports imports
       let (imp_gbl_envs, imp_avails) = unzip stuff
           gbl_env :: GlobalRdrEnv
           gbl_env = foldr plusGlobalRdrEnv emptyGlobalRdrEnv imp_gbl_envs

           all_avails :: ImportAvails
           all_avails = foldr plusImportAvails emptyImportAvails imp_avails
       -- ALL DONE
       return (gbl_env, all_avails)

126
127
128
\end{code}
	
\begin{code}
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
rnImportDecl :: ModIface -> ImpDeclSpec -> ImportDecl RdrName -> NameSet -> RnM (ImportDecl Name)
rnImportDecl iface decl_spec (ImportDecl loc_imp_mod_name want_boot qual_only as_mod Nothing) all_names
    = return $ ImportDecl loc_imp_mod_name want_boot qual_only as_mod Nothing
rnImportDecl iface decl_spec (ImportDecl loc_imp_mod_name want_boot qual_only as_mod (Just (want_hiding,import_items))) all_names
    = do import_items_mbs <- mapM (srcSpanWrapper) import_items
         let rn_import_items = concat . catMaybes $ import_items_mbs
         return $ ImportDecl loc_imp_mod_name want_boot qual_only as_mod (Just (want_hiding,rn_import_items))
    where
    srcSpanWrapper (L span ieRdr)
        = setSrcSpan span $
          case get_item ieRdr of
            Nothing
                -> do addErr (badImportItemErr iface decl_spec ieRdr)
                      return Nothing
            Just ieNames
                -> return (Just [L span ie | ie <- ieNames])
    occ_env :: OccEnv Name	-- Maps OccName to corresponding Name
    occ_env = mkOccEnv [(nameOccName n, n) | n <- nameSetToList all_names]
	-- This env will have entries for data constructors too,
	-- they won't make any difference because naked entities like T
	-- in an import list map to TcOccs, not VarOccs.

    sub_env :: NameEnv [Name]
    sub_env = mkSubNameEnv all_names

    get_item :: IE RdrName -> Maybe [IE Name]
        -- Empty result for a bad item.
	-- Singleton result is typical case.
        -- Can have two when we are hiding, and mention C which might be
	--	both a class and a data constructor.  
    get_item item@(IEModuleContents _) 
      = Nothing

    get_item (IEThingAll tc)
      = do name <- check_name tc
           return [IEThingAll name]
{-
   -> -- This occurs when you import T(..), but
			-- only export T abstractly.  The single [n]
			-- in the AvailTC is the type or class itself
			ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn tc)) `thenM_`
		     	return [ IEThingAll n ]

	  names -> return [ IEThingAll n | n <- names ]
-}

    get_item (IEThingAbs tc)
        | want_hiding   -- hiding ( C )
                        -- Here the 'C' can be a data constructor 
                        --  *or* a type/class, or even both
            = case catMaybes [check_name tc, check_name (setRdrNameSpace tc srcDataName)] of
                []    -> Nothing
                names -> return [ IEThingAbs n | n <- names ]
        | otherwise
            = do name <- check_name tc
                 return [IEThingAbs name]
    get_item (IEThingWith n ns) -- import (C (A,B))
        = do name <- check_name n
             let env = mkOccEnv [(nameOccName s, s) | s <- subNames sub_env name]
                 mb_names = map (lookupOccEnv env . rdrNameOcc) ns
             names <- sequence mb_names
             return [IEThingWith name names]

    get_item (IEVar n)
      = do name <- check_name n
           return [IEVar name]

    check_name :: RdrName -> Maybe Name
    check_name rdrName
	= lookupOccEnv occ_env (rdrNameOcc rdrName)


importsFromImportDeclDirect :: Module
                            -> LImportDecl RdrName
                            -> RnM (LImportDecl Name)
importsFromImportDeclDirect this_mod
                            (L loc importDecl@(ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
    = setSrcSpan loc $
      do iface <- loadSrcInterface doc imp_mod_name want_boot
208
         let filtered_exports = filter not_this_mod (mi_exports iface)
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
             not_this_mod (mod,_) = mod /= this_mod

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

             qual_mod_name = case as_mod of
                               Nothing  	    -> imp_mod_name
                               Just another_name -> another_name
             imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,  
                                       is_dloc = loc, is_as = qual_mod_name }

	 -- Get the total imports, and filter them according to the import list
235
         total_avails <- ifaceExportNames (mi_exports iface)
236
237
238
239
240
         importDecl' <- rnImportDecl iface imp_spec importDecl total_avails
         return (L loc importDecl')
    where imp_mod_name = unLoc loc_imp_mod_name
          doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")

241
importsFromImportDecl :: Module
242
		      -> LImportDecl Name
243
		      -> RnM (GlobalRdrEnv, ImportAvails)
244

245
importsFromImportDecl this_mod
246
247
	(L loc (ImportDecl loc_imp_mod_name want_boot qual_only as_mod imp_details))
  = 
248
    setSrcSpan loc $
249
250
251

	-- If there's an error in loadInterface, (e.g. interface
	-- file not found) we get lots of spurious errors from 'filterImports'
252
    let
253
	imp_mod_name = unLoc loc_imp_mod_name
254
	doc = ppr imp_mod_name <+> ptext SLIT("is directly imported")
255
    in
256
    loadSrcInterface doc imp_mod_name want_boot	`thenM` \ iface ->
257

258
259
260
	-- 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 )
261

262
263
264
265
266
	-- 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_`
267

268
    let
269
270
271
272
273
274
	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)
275
	not_this_mod (mod,_) = mod /= this_mod
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
	-- 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.
292
293
294
295

	qual_mod_name = case as_mod of
			  Nothing  	    -> imp_mod_name
			  Just another_name -> another_name
296
297
	imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,  
		  		  is_dloc = loc, is_as = qual_mod_name }
298
    in
299
	-- Get the total imports, and filter them according to the import list
300
    ifaceExportNames filtered_exports		`thenM` \ total_avails ->
301
302
    filterImports iface imp_spec
		  imp_details total_avails	`thenM` \ (avail_env, gbl_env) ->
303

304
305
    getDOpts `thenM` \ dflags ->

306
    let
307
	-- Compute new transitive dependencies
308
309
310

 	orphans | is_orph   = ASSERT( not (imp_mod_name `elem` dep_orphs deps) )
			      imp_mod_name : dep_orphs deps
311
		| otherwise = dep_orphs deps
312
313

	(dependent_mods, dependent_pkgs) 
314
	   = case mi_package iface of
315
		HomePackage ->
316
	    	-- Imported module is from the home package
317
		-- Take its dependent modules and add imp_mod itself
318
		-- Take its dependent packages unchanged
319
320
321
322
323
324
325
326
327
328
		--
		-- NB: (dep_mods deps) might include a hi-boot file
		-- for the module being compiled, CM. Do *not* filter
		-- this out (as we used to), because when we've
		-- finished dealing with the direct imports we want to
		-- know if any of them depended on CM.hi-boot, in
		-- which case we should do the hi-boot consistency
		-- check.  See LoadIface.loadHiBootInterface
		  ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)

329
		ExtPackage pkg ->
330
 	   	-- Imported module is from another package
331
		-- Dump the dependent modules
332
		-- Add the package imp_mod comes from to the dependent packages
333
334
	         ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
	         ([], pkg : dep_pkgs deps)
335

336
	-- True <=> import M ()
337
	import_all = case imp_details of
338
339
			Just (is_hiding, ls) -> not is_hiding && null ls	
			other 		     -> False
340
341
342
343
344

	-- 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.
345
	imports   = ImportAvails { 
346
			imp_env      = unitModuleEnv qual_mod_name avail_env,
347
			imp_mods     = unitModuleEnv imp_mod (imp_mod, import_all, loc),
348
349
350
			imp_orphs    = orphans,
			imp_dep_mods = mkModDeps dependent_mods,
			imp_dep_pkgs = dependent_pkgs }
351

352
    in
353
	-- Complain if we import a deprecated module
354
    ifOptM Opt_WarnDeprecations	(
355
       case deprecs of	
356
357
358
	  DeprecAll txt -> addWarn (moduleDeprec imp_mod_name txt)
	  other	        -> returnM ()
    )							`thenM_`
359

360
    returnM (gbl_env, imports)
361

362
363
364
warnRedundantSourceImport mod_name
  = ptext SLIT("Unnecessary {- SOURCE -} in the import of module")
          <+> quotes (ppr mod_name)
365
366
367
\end{code}


368
369
370
371
372
373
374
375
376
377
378
379
380
%************************************************************************
%*									*
		importsFromLocalDecls
%*									*
%************************************************************************

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

381
\begin{code}
382
importsFromLocalDecls :: HsGroup RdrName -> RnM TcGblEnv
383
importsFromLocalDecls group
384
  = do	{ gbl_env  <- getGblEnv
385

386
	; names <- getLocalDeclBinders gbl_env group
387

388
389
	; implicit_prelude <- doptM Opt_ImplicitPrelude
	; let {
390
391
392
	    -- 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
393
	    -- envt is no use.  To avoid doing this filter all the time,
394
	    -- we use -fno-implicit-prelude as a clue that the filter is
395
	    -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
396
397
398
399
	    --
	    -- It's worth doing because it makes the environment smaller for
	    -- every module that imports the Prelude
	    --
400
401
	    -- Note: don't filter the gbl_env (hence all_names, not filered_all_names
	    -- in defn of gres above).      Stupid reason: when parsing 
402
403
	    -- data type decls, the constructors start as Exact tycon-names,
	    -- and then get turned into data con names by zapping the name space;
404
405
406
	    -- 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.
407
	    -- The important thing is to trim down the exports.
408
409
410
	      filtered_names 
	        | implicit_prelude = names
	        | otherwise	   = filter (not . isBuiltInSyntax) names ;
411

412
413
414
	    ; this_mod = tcg_mod gbl_env
	    ; imports = emptyImportAvails {
			  imp_env = unitModuleEnv this_mod $
415
				    mkNameSet filtered_names
416
417
		        }
	    }
418

419
	; rdr_env' <- extendRdrEnvRn (tcg_rdr_env gbl_env) names
420

421
422
423
424
	; returnM (gbl_env { tcg_rdr_env = rdr_env',
			     tcg_imports = imports `plusImportAvails` tcg_imports gbl_env }) 
	}

425
extendRdrEnvRn :: GlobalRdrEnv -> [Name] -> RnM GlobalRdrEnv
426
427
428
-- Add the new locally-bound names one by one, checking for duplicates as
-- we do so.  Remember that in Template Haskell the duplicates
-- might *already be* in the GlobalRdrEnv from higher up the module
429
extendRdrEnvRn rdr_env names
430
431
432
433
434
435
436
437
438
439
  = foldlM add_local rdr_env names
  where
    add_local rdr_env name
	| gres <- lookupGlobalRdrEnv rdr_env (nameOccName name)
	, (dup_gre:_) <- filter isLocalGRE gres	-- Check for existing *local* defns
	= do { addDupDeclErr (gre_name dup_gre) name
	     ; return rdr_env }
	| otherwise
	= return (extendGlobalRdrEnv rdr_env new_gre)
	where
440
	  new_gre = GRE {gre_name = name, gre_prov = LocalDef}
441
\end{code}
442

443
444
@getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
used for source code.
445

446
447
448
	*** See "THE NAMING STORY" in HsDecls ****

\begin{code}
449
getLocalDeclBinders :: TcGblEnv -> HsGroup RdrName -> RnM [Name]
450
getLocalDeclBinders gbl_env (HsGroup {hs_valds = ValBindsIn val_decls val_sigs, 
451
452
453
454
455
456
457
458
459
460
				      hs_tyclds = tycl_decls, 
				      hs_fords = foreign_decls })
  = do	{ tc_names_s <- mappM new_tc tycl_decls
	; val_names  <- mappM new_simple val_bndrs
	; return (foldr (++) val_names tc_names_s) }
  where
    mod        = tcg_mod gbl_env
    is_hs_boot = isHsBoot (tcg_src gbl_env) ;
    val_bndrs | is_hs_boot = sig_hs_bndrs
	      | otherwise  = for_hs_bndrs ++ val_hs_bndrs
461
	-- In a hs-boot file, the value binders come from the
462
	--  *signatures*, and there should be no foreign binders 
463
464

    new_simple rdr_name = newTopSrcBinder mod Nothing rdr_name
465

466
    sig_hs_bndrs = [nm | L _ (TypeSig nm _) <- val_sigs]
467
    val_hs_bndrs = collectHsBindLocatedBinders val_decls
468
    for_hs_bndrs = [nm | L _ (ForeignImport nm _ _ _) <- foreign_decls]
469

470
    new_tc tc_decl 
471
472
473
	= do { main_name <- newTopSrcBinder mod Nothing main_rdr
	     ; sub_names <- mappM (newTopSrcBinder mod (Just main_name)) sub_rdrs
	     ; return (main_name : sub_names) }
474
	where
475
	  (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
476
477
\end{code}

478

479
480
481
482
483
484
485
486
487
488
%************************************************************************
%*									*
\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}
489
filterImports :: ModIface
490
	      -> ImpDeclSpec			-- The span for the entire import decl
491
	      -> Maybe (Bool, [LIE Name])	-- Import spec; True => hiding
492
493
	      -> NameSet			-- What's available
	      -> RnM (NameSet,			-- What's imported (qualified or unqualified)
494
		      GlobalRdrEnv)		-- Same again, but in GRE form
495
496
497

	-- Complains if import spec mentions things that the module doesn't export
        -- Warns/informs if import spec contains duplicates.
498
			
499
mkGenericRdrEnv decl_spec names
500
  = mkGlobalRdrEnv [ GRE { gre_name = name, gre_prov = Imported [imp_spec] }
501
		   | name <- nameSetToList names ]
502
503
  where
    imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
504

505
filterImports iface decl_spec Nothing all_names
506
  = return (all_names, mkGenericRdrEnv decl_spec all_names)
507

508
filterImports iface decl_spec (Just (want_hiding, import_items)) all_names
509
510
511
512
513
514
515
516
  = mapM (addLocM get_item) import_items >>= \gres_s ->
    let gres = concat gres_s
        specified_names = mkNameSet (map gre_name gres)
    in if not want_hiding then
       return (specified_names, mkGlobalRdrEnv gres)
    else let keep n = not (n `elemNameSet` specified_names)
             pruned_avails = filterNameSet keep all_names
         in return (pruned_avails, mkGenericRdrEnv decl_spec pruned_avails)
517
  where
518
    sub_env :: NameEnv [Name]	-- Classify each name by its parent
519
520
521
522
    sub_env = mkSubNameEnv all_names

    succeed_with :: Bool -> [Name] -> RnM [GlobalRdrElt]
    succeed_with all_explicit names
523
      = do { loc <- getSrcSpanM
524
	   ; returnM (map (mk_gre loc) names) }
525
526
      where
	mk_gre loc name = GRE { gre_name = name, 
527
				gre_prov = Imported [imp_spec] }
528
	  where
529
530
531
	    imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
	    item_spec = ImpSome { is_explicit = explicit, is_iloc = loc }
	    explicit  = all_explicit || isNothing (nameParent_maybe name)
532

533
    get_item :: IE Name -> RnM [GlobalRdrElt]
534
535
	-- Empty result for a bad item.
	-- Singleton result is typical case.
536
537
	-- Can have two when we are hiding, and mention C which might be
	--	both a class and a data constructor.  
538
    get_item item@(IEModuleContents _) 
539
540
        -- This case should be filtered out by 'rnImports'.
        = panic "filterImports: IEModuleContents?" 
541

542
543
544
545
546
    get_item (IEThingAll name)
        = case subNames sub_env name of
            [] -> do ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn name))
                     succeed_with False [name]
            names -> succeed_with False (name:names)
547

548
549
    get_item (IEThingAbs name)
        = succeed_with True [name]
550

551
552
553
554
    get_item (IEThingWith name names)
        = succeed_with True (name:names)
    get_item (IEVar name)
        = succeed_with True [name]
555

556
557
558
559
560
\end{code}


%************************************************************************
%*									*
561
\subsection{Export list processing}
562
563
564
565
566
%*									*
%************************************************************************

Processing the export list.

567
568
569
570
571
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).
572

573
574
575
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...
576
577
578

\begin{code}
type ExportAccum	-- The type of the accumulating parameter of
579
			-- the main worker function in rnExports
580
     = ([Module], 		-- 'module M's seen so far
581
	ExportOccMap,		-- Tracks exported occurrence names
582
583
	NameSet)		-- The accumulated exported stuff
emptyExportAccum = ([], emptyOccEnv, emptyNameSet) 
584

585
type ExportOccMap = OccEnv (Name, IE Name)
586
587
588
589
590
	-- 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

591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
rnExports :: Maybe [LIE RdrName]
          -> RnM (Maybe [LIE Name])
rnExports Nothing = return Nothing
rnExports (Just exports)
    = do TcGblEnv { tcg_imports = ImportAvails { imp_env = imp_env } } <- getGblEnv
         let sub_env :: NameEnv [Name]	-- Classify each name by its parent
             sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)
             inLoc fn (L span x)
                 = do x' <- fn x
                      return (L span x')
             rnExport (IEVar rdrName)
                 = do name <- lookupGlobalOccRn rdrName
                      return (IEVar name)
             rnExport (IEThingAbs rdrName)
                 = do name <- lookupGlobalOccRn rdrName
                      return (IEThingAbs name)
             rnExport (IEThingAll rdrName)
                 = do name <- lookupGlobalOccRn rdrName
                      return (IEThingAll name)
             rnExport (IEThingWith rdrName rdrNames)
                 = do name <- lookupGlobalOccRn rdrName
                      let env = mkOccEnv [(nameOccName s, s) | s <- subNames sub_env name]
                          mb_names = map (lookupOccEnv env . rdrNameOcc) rdrNames
                      if any isNothing mb_names
                         then -- The export error will be reporting in 'mkExportNameSet'
                              return (IEThingWith name [])
                         else return (IEThingWith name (catMaybes mb_names))
             rnExport (IEModuleContents mod)
                 = return (IEModuleContents mod)
         rn_exports <- mapM (inLoc rnExport) exports
         return (Just rn_exports)

mkExportNameSet :: Bool  -- False => no 'module M(..) where' header at all
                -> Maybe [LIE Name] -- Nothing => no explicit export list
                -> RnM NameSet
626
627
628
	-- Complains if two distinct exports have same OccName
        -- Warns about identical exports.
	-- Complains about exports items not in scope
629

630
631
632
mkExportNameSet explicit_mod exports
 = do TcGblEnv { tcg_rdr_env = rdr_env, 
                 tcg_imports = imports } <- getGblEnv
633
634
635
636
637
638
639

	-- 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
640
641
642
643
644
645
646
647
648
      ghci_mode <- getGhciMode
      real_exports <- case () of
                        () | explicit_mod
                               -> return exports
                           | ghci_mode == Interactive
                               -> return Nothing
                           | otherwise
                               -> do mainName <- lookupGlobalOccRn main_RDR_Unqual
                                     return (Just [noLoc (IEVar mainName)])
649
		-- ToDo: the 'noLoc' here is unhelpful if 'main' turns out to be out of scope
650
      exports_from_avail real_exports rdr_env imports
651

652

653
exports_from_avail Nothing rdr_env imports
654
655
 =  	-- Export all locally-defined things
	-- We do this by filtering the global RdrEnv,
656
657
658
659
	-- keeping only things that are locally-defined
   return (mkNameSet [ gre_name gre 
		     | gre <- globalRdrEnvElts rdr_env,
		       isLocalGRE gre ])
660

661
exports_from_avail (Just items) rdr_env (ImportAvails { imp_env = imp_env }) 
662
663
  = do (_, _, exports) <- foldlM do_litem emptyExportAccum items
       return exports
664
  where
665
666
667
    sub_env :: NameEnv [Name]	-- Classify each name by its parent
    sub_env = mkSubNameEnv (foldModuleEnv unionNameSets emptyNameSet imp_env)

668
    do_litem :: ExportAccum -> LIE Name -> RnM ExportAccum
669
    do_litem acc = addLocM (exports_from_item acc)
670

671
    exports_from_item :: ExportAccum -> IE Name -> RnM ExportAccum
672
    exports_from_item acc@(mods, occs, exports) ie@(IEModuleContents mod)
673
	| mod `elem` mods 	-- Duplicate export of M
674
675
676
	= do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
	       warnIf warn_dup_exports (dupModuleExport mod) ;
	       returnM acc }
677
678

	| otherwise
679
	= case lookupModuleEnv imp_env mod of
680
681
682
683
684
685
686
687
688
689
            Nothing -> do addErr (modExportErr mod)
                          return acc
            Just names
                -> do let new_exports = filterNameSet (inScopeUnqual rdr_env) names
                      -- 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.
                      occs' <- check_occs ie occs (nameSetToList new_exports)
                      return (mod:mods, occs', exports `unionNameSets` new_exports)
690

691
    exports_from_item acc@(mods, occs, exports) ie
692
693
694
695
696
697
698
        = if isUnboundName (ieName ie)
          then return acc 	-- Avoid error cascade
          else let new_exports = filterAvail ie sub_env in
          do checkErr (not (null new_exports)) (exportItemErr ie)
             checkForDodgyExport ie new_exports
             occs' <- check_occs ie occs new_exports
             return (mods, occs', addListToNameSet exports new_exports)
699
700
	  
-------------------------------
701
filterAvail :: IE Name  	-- Wanted
702
	    -> NameEnv [Name]	-- Maps type/class names to their sub-names
703
704
705
706
707
708
709
	    -> [Name]

filterAvail (IEVar n)          subs = [n]
filterAvail (IEThingAbs n)     subs = [n]
filterAvail (IEThingAll n)     subs = n : subNames subs n
filterAvail (IEThingWith n ns) subs = n : ns
filterAvail (IEModuleContents _) _  = panic "filterAvail"
710
711
712

subNames :: NameEnv [Name] -> Name -> [Name]
subNames env n = lookupNameEnv env n `orElse` []
713

714
715
716
717
718
719
720
721
722
723
mkSubNameEnv :: NameSet -> NameEnv [Name]
-- Maps types and classes to their constructors/classops respectively
-- This mapping just makes it easier to deal with A(..) export items
mkSubNameEnv names
  = foldNameSet add_name emptyNameEnv names
  where
    add_name name env 
	| Just parent <- nameParent_maybe name 
	= extendNameEnv_C (\ns _ -> name:ns) env parent [name]
	| otherwise = env
724

725
-------------------------------
726
inScopeUnqual :: GlobalRdrEnv -> Name -> Bool
727
728
-- Checks whether the Name is in scope unqualified, 
-- regardless of whether it's ambiguous or not
729
inScopeUnqual env n = any unQualOK (lookupGRE_Name env n)
730

731
-------------------------------
732
checkForDodgyExport :: IE Name -> [Name] -> RnM ()
733
734
735
736
737
738
739
checkForDodgyExport ie@(IEThingAll tc) [n] 
  | isTcOcc (nameOccName n) = addWarn (dodgyExportWarn tc)
	-- This occurs when you export T(..), but
	-- only import T abstractly, or T is a synonym.  
	-- The single [n] is the type or class itself
  | otherwise = addErr (exportItemErr ie)
	-- This happes if you export x(..), which is bogus
740
checkForDodgyExport _ _ = return ()
741

742
-------------------------------
743
check_occs :: IE Name -> ExportOccMap -> [Name] -> RnM ExportOccMap
744
745
check_occs ie occs names
  = foldlM check occs names
746
  where
747
    check occs name
748
749
      = case lookupOccEnv occs name_occ of
	  Nothing -> returnM (extendOccEnv occs name_occ (name, ie))
750

751
	  Just (name', ie') 
752
753
754
755
756
757
758
759
760
	    | 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 }
761
762
763
764
      where
	name_occ = nameOccName name
\end{code}

765
766
%*********************************************************
%*						 	 *
767
768
769
770
771
772
773
774
		Deprecations
%*							 *
%*********************************************************

\begin{code}
reportDeprecations :: TcGblEnv -> RnM ()
reportDeprecations tcg_env
  = ifOptM Opt_WarnDeprecations	$
775
    do	{ (eps,hpt) <- getEpsAndHpt
776
777
		-- By this time, typechecking is complete, 
		-- so the PIT is fully populated
778
779
	; mapM_ (check hpt (eps_PIT eps)) all_gres }
  where
780
781
    used_names = allUses (tcg_dus tcg_env) 
	-- Report on all deprecated uses; hence allUses
782
783
    all_gres   = globalRdrEnvElts (tcg_rdr_env tcg_env)

784
    check hpt pit (GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
785
786
      | name `elemNameSet` used_names
      ,	Just deprec_txt <- lookupDeprec hpt pit name
787
      = setSrcSpan (importSpecLoc imp_spec) $
788
	addWarn (sep [ptext SLIT("Deprecated use of") <+> 
789
			pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
790
		 	quotes (ppr name),
791
		      (parens imp_msg) <> colon,
792
793
		      (ppr deprec_txt) ])
	where
794
	  name_mod = nameModule name
795
	  imp_mod  = importSpecModule imp_spec
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
	  imp_msg  = ptext SLIT("imported from") <+> ppr imp_mod <> extra
	  extra | imp_mod == name_mod = empty
		| otherwise = ptext SLIT(", but defined in") <+> ppr name_mod

    check hpt pit ok_gre = returnM ()	-- Local, or not used, or not deprectated
	    -- The Imported pattern-match: don't deprecate locally defined names
	    -- 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

lookupDeprec :: HomePackageTable -> PackageIfaceTable 
	     -> Name -> Maybe DeprecTxt
lookupDeprec hpt pit n 
  = case lookupIface hpt pit (nameModule n) of
	Just iface -> mi_dep_fn iface n `seqMaybe` 	-- Bleat if the thing, *or
		      mi_dep_fn iface (nameParent n)	-- its parent*, is deprec'd
814
815
816
817
818
819
820
	Nothing    
	  | isWiredInName n -> Nothing
		-- We have not necessarily loaded the .hi file for a 
		-- wired-in name (yet), although we *could*.
		-- And we never deprecate them

	 | otherwise -> pprPanic "lookupDeprec" (ppr n)	
821
822
823
824
825
826
827
828
829
		-- By now all the interfaces should have been loaded

gre_is_used :: NameSet -> GlobalRdrElt -> Bool
gre_is_used used_names gre = gre_name gre `elemNameSet` used_names
\end{code}

%*********************************************************
%*						 	 *
		Unused names
830
831
832
833
%*							 *
%*********************************************************

\begin{code}
834
reportUnusedNames :: Maybe [LIE RdrName] 	-- Export list
835
836
		  -> TcGblEnv -> RnM ()
reportUnusedNames export_decls gbl_env 
837
838
  = do	{ traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
	; warnUnusedTopBinds   unused_locals
839
840
	; warnUnusedModules    unused_imp_mods
	; warnUnusedImports    unused_imports	
841
	; warnDuplicateImports defined_and_used
842
	; printMinimalImports  minimal_imports }
843
  where
844
845
    used_names, all_used_names :: NameSet
    used_names = findUses (tcg_dus gbl_env) emptyNameSet
846
847
848
	-- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
	-- Hence findUses

849
850
851
852
    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)
853
854
855

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

858
859
860
	-- Note that defined_and_used, defined_but_not_used
	-- are both [GRE]; that's why we need defined_and_used
	-- rather than just all_used_names
861
    defined_and_used, defined_but_not_used :: [GlobalRdrElt]
862
863
    (defined_and_used, defined_but_not_used) 
	= partition (gre_is_used all_used_names) defined_names
864
    
865
866
867
868
869
870
871
872
	-- 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
    unused_locals :: [GlobalRdrElt]
    unused_locals = filter is_unused_local defined_but_not_used
    is_unused_local :: GlobalRdrElt -> Bool
    is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
873
    
874
875
    unused_imports :: [GlobalRdrElt]
    unused_imports = filter unused_imp defined_but_not_used
876
    unused_imp (GRE {gre_prov = Imported imp_specs}) 
877
878
	= not (all (module_unused . importSpecModule) imp_specs)
	  && or [exp | ImpSpec { is_item = ImpSome { is_explicit = exp } } <- imp_specs]
879
880
		-- Don't complain about unused imports if we've already said the
		-- entire import is unused
881
    unused_imp other = False
882
883
884
885
    
    -- 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
886
887
    --
    -- BUG WARNING: this does not deal properly with qualified imports!
888
    minimal_imports :: FiniteMap Module AvailEnv
889
    minimal_imports0 = foldr add_expall   emptyFM 	   expall_mods
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
    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.
910
    add_name (GRE {gre_name = n, gre_prov = Imported imp_specs}) acc 
911
	= addToFM_C plusAvailEnv acc (importSpecModule (head imp_specs))
912
		    (unitAvailEnv (mk_avail n (nameParent_maybe n)))
913
914
915
    add_name other acc 
	= acc

916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
	-- Modules mentioned as 'module M' in the export list
    expall_mods = case export_decls of
		    Nothing -> []
		    Just es -> [m | L _ (IEModuleContents m) <- es]

	-- This is really bogus.  The idea is that if we see 'module M' in 
	-- the export list we must retain the import decls that drive it
	-- If we aren't careful we might see
	--	module A( module M ) where
	--	  import M
	--	  import N
	-- and suppose that N exports everything that M does.  Then we 
	-- must not drop the import of M even though N brings it all into
	-- scope.
	--
	-- BUG WARNING: 'module M' exports aside, what if M.x is mentioned?!
	--
	-- The reason that add_expall is bogus is that it doesn't take
	-- qualified imports into account.  But it's an improvement.
    add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv

937
	-- n is the name of the thing, p is the name of its parent
938
939
940
    mk_avail n (Just p)			 	 = AvailTC p [p,n]
    mk_avail n Nothing | isTcOcc (nameOccName n) = AvailTC n [n]
		       | otherwise		 = Avail n
941
    
942
    add_inst_mod (mod,_,_) acc 
943
944
      | mod `elemFM` acc = acc	-- We import something already
      | otherwise        = addToFM acc mod emptyAvailEnv
945
      where
946
947
948
    	-- Add an empty collection of imports for a module
    	-- from which we have sucked only instance decls
   
949
    imports = tcg_imports gbl_env
950

951
    direct_import_mods :: [(Module, Bool, SrcSpan)]
952
953
	-- See the type of the imp_mods for this triple
    direct_import_mods = moduleEnvElts (imp_mods imports)
sof's avatar
sof committed
954

955
    -- unused_imp_mods are the directly-imported modules 
956
    -- that are not mentioned in minimal_imports1
957
    -- [Note: not 'minimal_imports', because that includes directly-imported
958
    --	      modules even if we use nothing from them; see notes above]
959
960
961
    --
    -- BUG WARNING: does not deal correctly with multiple imports of the same module
    --	 	    becuase direct_import_mods has only one entry per module
962
    unused_imp_mods = [(mod,loc) | (mod,no_imp,loc) <- direct_import_mods,
963
964
    		       not (mod `elemFM` minimal_imports1),
    		       mod /= pRELUDE,
965
966
		       not no_imp]
	-- The not no_imp part is not to complain about
967
968
969
	-- import M (), which is an idiom for importing
	-- instance declarations
    
970
    module_unused :: Module -> Bool
971
    module_unused mod = any (((==) mod) . fst) unused_imp_mods
972

973
---------------------
974
warnDuplicateImports :: [GlobalRdrElt] -> RnM ()
975
976
977
978
979
980
981
982
983
984
985
986
987
-- Given the GREs for names that are used, figure out which imports 
-- could be omitted without changing the top-level environment.
--
-- NB: Given import Foo( T )
--     	     import qualified Foo
-- we do not report a duplicate import, even though Foo.T is brought
-- into scope by both, because there's nothing you can *omit* without
-- changing the top-level environment.  So we complain only if it's
-- explicitly named in both imports or neither.
--
-- Furthermore, we complain about Foo.T only if 
-- there is no complaint about (unqualified) T

988
warnDuplicateImports gres
989
  = ifOptM Opt_WarnUnusedImports $ 
990
    sequenceM_	[ warn name pr
991
992
993
			-- The 'head' picks the first offending group
			-- for this particular name
		| GRE { gre_name = name, gre_prov = Imported imps } <- gres
994
		, pr <- redundants imps ]
995
  where
996
    warn name (red_imp, cov_imp)
997
	= addWarnAt (importSpecLoc red_imp)
998
999
	    (vcat [ptext SLIT("Redundant import of:") <+> quotes pp_name,
	           ptext SLIT("It is also") <+> ppr cov_imp])
1000
	where
1001
	  pp_name | is_qual red_decl = ppr (is_as red_decl) <> dot <> ppr occ
1002
		  | otherwise	    = ppr occ
1003
	  occ = nameOccName name
1004
	  red_decl = is_decl red_imp
1005
    
1006
1007
1008
1009
1010
1011
1012
    redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
	-- The returned pair is (redundant-import, covering-import)
    redundants imps 
	= [ (red_imp, cov_imp) 
	  | red_imp <- imps
	  , cov_imp <- take 1 (filter (covers red_imp) imps) ]

1013
1014
	-- "red_imp" is a putative redundant import
	-- "cov_imp" potentially covers it
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
	-- This test decides whether red_imp could be dropped 
	--
	-- NOTE: currently the test does not warn about
	--		import M( x )
	--		imoprt N( x )
	-- even if the same underlying 'x' is involved, because dropping
	-- either import would change the qualified names in scope (M.x, N.x)
	-- But if the qualified names aren't used, the import is indeed redundant
	-- Sadly we don't know that.  Oh well.
    covers red_imp@(ImpSpec { is_decl = red_decl, is_item = red_item }) 
	   cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
1026
	| red_loc == cov_loc
1027
  	= False		-- Ignore diagonal elements
1028
	| not (is_as red_decl == is_as cov_decl)
1029
	= False		-- They bring into scope different qualified names
1030
	| not (is_qual red_decl) && is_qual cov_decl
1031
	= False		-- Covering one doesn't bring unqualified name into scope
1032
1033
	| red_selective
	= not cov_selective 	-- Redundant one is selective and covering one isn't
1034
1035
	  || red_later		-- Both are explicit; tie-break using red_later
	| otherwise		
1036
1037
	= not cov_selective 	-- Neither import is selective
	  && (is_mod red_decl == is_mod cov_decl)	-- They import the same module
1038
	  && red_later 		-- Tie-break
1039
	where
1040
1041
	  red_loc   = importSpecLoc red_imp
	  cov_loc   = importSpecLoc cov_imp
1042
	  red_later = red_loc > cov_loc
1043
1044
1045
1046
1047
1048
	  cov_selective = selectiveImpItem cov_item
	  red_selective = selectiveImpItem red_item

selectiveImpItem :: ImpItemSpec -> Bool
selectiveImpItem ImpAll       = False
selectiveImpItem (ImpSome {}) = True
1049

1050
-- ToDo: deal with original imports with 'qualified' and 'as M' clauses
1051
printMinimalImports :: FiniteMap Module AvailEnv	-- Minimal imports
1052
		    -> RnM ()
1053
1054
1055
1056
1057
1058
1059
1060
1061
1062
1063
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
1064
    mkFilename this_mod = moduleString this_mod ++ ".imports"
1065
    ppr_mod_ie (mod_name, ies) 
1066
	| mod_name == pRELUDE 
1067
	= empty
1068
1069
	| null ies	-- Nothing except instances comes from here
	= ptext SLIT("import") <+> ppr mod_name <> ptext SLIT("()    -- Instances only")
1070
1071
	| otherwise
	= ptext SLIT("import") <+> ppr mod_name <> 
1072
		    parens (fsep (punctuate comma (map ppr ies)))
1073

1074
1075
    to_ies (mod, avail_env) = do ies <- mapM to_ie (availEnvElts avail_env)
                                 returnM (mod, ies)
1076

1077
    to_ie :: AvailInfo -> RnM (IE Name)
1078
1079
1080
1081
1082
1083
1084
	-- 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)  
1085
	= loadSrcInterface doc n_mod False			`thenM` \ iface ->
1086
1087
1088
	  case [xs | (m,as) <- mi_exports iface,
		     m == n_mod,
		     AvailTC x xs <- as, 
1089
1090
1091
1092
1093
		     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)
1094
	where
1095
1096
	  all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
	  doc = text "Compute minimal imports from" <+> ppr n
1097
	  n_mod = nameModule n
1098
1099
1100
\end{code}


1101
1102
1103
1104
1105
1106
1107
%************************************************************************
%*									*
\subsection{Errors}
%*									*
%************************************************************************

\begin{code}
1108
1109
badImportItemErr iface decl_spec ie
  = sep [ptext SLIT("Module"), quotes (ppr (is_mod decl_spec)), source_import,
1110
	 ptext SLIT("does not export"), quotes (ppr ie)]
1111
  where
1112
1113
    source_import | mi_boot iface = ptext SLIT("(hi-boot interface)")
		  | otherwise     = empty
1114

1115
1116
dodgyImportWarn item = dodgyMsg (ptext SLIT("import")) item
dodgyExportWarn item = dodgyMsg (ptext SLIT("export")) item
1117

1118
1119
dodgyMsg kind tc
  = sep [ ptext SLIT("The") <+> kind <+> ptext SLIT("item") <+> quotes (ppr (IEThingAll tc)),
1120
1121
1122
	  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") ]
	  
1123
modExportErr mod
1124
  = hsep [ ptext SLIT("Unknown module in export list: module"), quotes (ppr mod)]
1125
1126

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

1130
1131
1132
1133
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  ]
1134
  where
1135
1136
1137
1138
    occ = nameOccName name1
    ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext SLIT("exports") <+> 
			 	 quotes (ppr name) <+> pprNameProvenance (get_gre name))

1139
	-- get_gre finds a GRE for the Name, so that we can show its provenance
1140
    get_gre name
1141
	= case lookupGRE_Name global_env name of
1142
1143
	     (gre:_) -> gre
	     []	     -> pprPanic "exportClashErr" (ppr name)
1144

1145
addDupDeclErr :: Name -> Name -> TcRn ()
1146
addDupDeclErr name_a name_b
1147
  = addErrAt (srcLocSpan loc2) $
1148
    vcat [ptext SLIT("Multiple declarations of") <+> quotes (ppr name1),
1149
	  ptext SLIT("Declared at:") <+> vcat [ppr (nameSrcLoc name1), ppr loc2]]
1150
  where
1151
1152
1153
1154
    loc2 = nameSrcLoc name2
    (name1,name2) | nameSrcLoc name_a > nameSrcLoc name_b = (name_b,name_a)
		  | otherwise				  = (name_a,name_b)
	-- Report the error at the later location
1155
1156
1157
1158
1159
1160
1161
1162

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"),
1163
	  quotes (ptext SLIT("Module") <+> ppr mod), 
1164
          ptext SLIT("in export list")]
1165
1166
1167
1168

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