Don't warn if 'import Prelude' doesn't import anything
[ghc-hetmet.git] / compiler / rename / RnNames.lhs
1 %
2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
3 %
4 \section[RnNames]{Extracting imported and top-level names in scope}
5
6 \begin{code}
7 module RnNames (
8         rnImports, getLocalNonValBinders,
9         rnExports, extendGlobalRdrEnvRn,
10         reportUnusedNames, finishWarnings,
11     ) where
12
13 #include "HsVersions.h"
14
15 import DynFlags
16 import HsSyn
17 import RnEnv
18 import RnHsDoc          ( rnHsDoc )
19 import IfaceEnv         ( ifaceExportNames )
20 import LoadIface        ( loadSrcInterface, loadSysInterface )
21 import TcRnMonad hiding (LIE)
22
23 import PrelNames
24 import Module
25 import Name
26 import NameEnv
27 import NameSet
28 import OccName
29 import HscTypes
30 import RdrName
31 import Outputable
32 import Maybes
33 import SrcLoc
34 import FiniteMap
35 import ErrUtils
36 import BasicTypes       ( WarningTxt(..) )
37 import DriverPhases     ( isHsBoot )
38 import Util
39 import FastString
40 import ListSetOps
41 import Data.List        ( partition, concatMap, (\\), delete )
42 import IO               ( openFile, IOMode(..) )
43 import Monad            ( when, mplus )
44 \end{code}
45
46
47
48 %************************************************************************
49 %*                                                                      *
50                 rnImports
51 %*                                                                      *
52 %************************************************************************
53
54 \begin{code}
55 rnImports :: [LImportDecl RdrName]
56            -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage)
57
58 rnImports imports
59          -- PROCESS IMPORT DECLS
60          -- Do the non {- SOURCE -} ones first, so that we get a helpful
61          -- warning for {- SOURCE -} ones that are unnecessary
62     = do this_mod <- getModule
63          implicit_prelude <- doptM Opt_ImplicitPrelude
64          let prel_imports       = mkPrelImports this_mod implicit_prelude imports
65              (source, ordinary) = partition is_source_import imports
66              is_source_import (L _ (ImportDecl _ _ is_boot _ _ _)) = is_boot
67
68          ifOptM Opt_WarnImplicitPrelude (
69             when (notNull prel_imports) $ addWarn (implicitPreludeWarn)
70           )
71
72          stuff1 <- mapM (rnImportDecl this_mod) (prel_imports ++ ordinary)
73          stuff2 <- mapM (rnImportDecl this_mod) source
74          let (decls, rdr_env, imp_avails,hpc_usage) = combine (stuff1 ++ stuff2)
75          return (decls, rdr_env, imp_avails,hpc_usage) 
76
77     where
78    combine :: [(LImportDecl Name,  GlobalRdrEnv, ImportAvails,AnyHpcUsage)]
79            -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails,AnyHpcUsage)
80    combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails,False)
81         where plus (decl,  gbl_env1, imp_avails1,hpc_usage1)
82                    (decls, gbl_env2, imp_avails2,hpc_usage2)
83                 = (decl:decls, 
84                    gbl_env1 `plusGlobalRdrEnv` gbl_env2,
85                    imp_avails1 `plusImportAvails` imp_avails2,
86                    hpc_usage1 || hpc_usage2)
87
88 mkPrelImports :: Module -> Bool -> [LImportDecl RdrName] -> [LImportDecl RdrName]
89 -- Consruct the implicit declaration "import Prelude" (or not)
90 --
91 -- NB: opt_NoImplicitPrelude is slightly different to import Prelude ();
92 -- because the former doesn't even look at Prelude.hi for instance 
93 -- declarations, whereas the latter does.
94 mkPrelImports this_mod implicit_prelude import_decls
95   | this_mod == pRELUDE
96    || explicit_prelude_import
97    || not implicit_prelude
98   = []
99   | otherwise = [preludeImportDecl]
100   where
101       explicit_prelude_import
102        = notNull [ () | L _ (ImportDecl mod Nothing _ _ _ _) <- import_decls, 
103                    unLoc mod == pRELUDE_NAME ]
104
105       preludeImportDecl :: LImportDecl RdrName
106       preludeImportDecl
107         = L loc $
108           ImportDecl (L loc pRELUDE_NAME)
109                Nothing {- no specific package -}
110                False {- Not a boot interface -}
111                False    {- Not qualified -}
112                Nothing  {- No "as" -}
113                Nothing  {- No import list -}
114
115       loc = mkGeneralSrcSpan (fsLit "Implicit import declaration")         
116
117
118 rnImportDecl  :: Module
119               -> LImportDecl RdrName
120               -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails,AnyHpcUsage)
121
122 rnImportDecl this_mod (L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
123                                          qual_only as_mod imp_details))
124   = 
125     setSrcSpan loc $ do
126
127     when (isJust mb_pkg) $ do
128         pkg_imports <- doptM Opt_PackageImports
129         when (not pkg_imports) $ addErr packageImportErr
130
131         -- If there's an error in loadInterface, (e.g. interface
132         -- file not found) we get lots of spurious errors from 'filterImports'
133     let
134         imp_mod_name = unLoc loc_imp_mod_name
135         doc = ppr imp_mod_name <+> ptext (sLit "is directly imported")
136
137     iface <- loadSrcInterface doc imp_mod_name want_boot mb_pkg
138
139         -- Compiler sanity check: if the import didn't say
140         -- {-# SOURCE #-} we should not get a hi-boot file
141     WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) (do
142
143         -- Issue a user warning for a redundant {- SOURCE -} import
144         -- NB that we arrange to read all the ordinary imports before 
145         -- any of the {- SOURCE -} imports
146     warnIf (want_boot && not (mi_boot iface))
147            (warnRedundantSourceImport imp_mod_name)
148
149     let
150         imp_mod    = mi_module iface
151         warns      = mi_warns iface
152         orph_iface = mi_orphan iface 
153         has_finsts = mi_finsts iface 
154         deps       = mi_deps iface
155
156         filtered_exports = filter not_this_mod (mi_exports iface)
157         not_this_mod (mod,_) = mod /= this_mod
158         -- If the module exports anything defined in this module, just
159         -- ignore it.  Reason: otherwise it looks as if there are two
160         -- local definition sites for the thing, and an error gets
161         -- reported.  Easiest thing is just to filter them out up
162         -- front. This situation only arises if a module imports
163         -- itself, or another module that imported it.  (Necessarily,
164         -- this invoves a loop.)
165         --
166         -- Tiresome consequence: if you say
167         --      module A where
168         --         import B( AType )
169         --         type AType = ...
170         --
171         --      module B( AType ) where
172         --         import {-# SOURCE #-} A( AType )
173         --
174         -- then you'll get a 'B does not export AType' message.  Oh well.
175
176         qual_mod_name = case as_mod of
177                           Nothing           -> imp_mod_name
178                           Just another_name -> another_name
179         imp_spec  = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,  
180                                   is_dloc = loc, is_as = qual_mod_name }
181     -- in
182
183         -- Get the total exports from this module
184     total_avails <- ifaceExportNames filtered_exports
185
186         -- filter the imports according to the import declaration
187     (new_imp_details, gbl_env) <- 
188         filterImports iface imp_spec imp_details total_avails
189
190     dflags <- getDOpts
191
192     let
193         -- Compute new transitive dependencies
194
195         orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
196                                imp_mod : dep_orphs deps
197                 | otherwise  = dep_orphs deps
198
199         finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
200                               imp_mod : dep_finsts deps
201                 | otherwise = dep_finsts deps
202
203         pkg = modulePackageId (mi_module iface)
204
205         (dependent_mods, dependent_pkgs) 
206            | pkg == thisPackage dflags =
207                 -- Imported module is from the home package
208                 -- Take its dependent modules and add imp_mod itself
209                 -- Take its dependent packages unchanged
210                 --
211                 -- NB: (dep_mods deps) might include a hi-boot file
212                 -- for the module being compiled, CM. Do *not* filter
213                 -- this out (as we used to), because when we've
214                 -- finished dealing with the direct imports we want to
215                 -- know if any of them depended on CM.hi-boot, in
216                 -- which case we should do the hi-boot consistency
217                 -- check.  See LoadIface.loadHiBootInterface
218                   ((imp_mod_name, want_boot) : dep_mods deps, dep_pkgs deps)
219
220            | otherwise =
221                 -- Imported module is from another package
222                 -- Dump the dependent modules
223                 -- Add the package imp_mod comes from to the dependent packages
224                  ASSERT2( not (pkg `elem` dep_pkgs deps), ppr pkg <+> ppr (dep_pkgs deps) )
225                  ([], pkg : dep_pkgs deps)
226
227         -- True <=> import M ()
228         import_all = case imp_details of
229                         Just (is_hiding, ls) -> not is_hiding && null ls        
230                         _                    -> False
231
232         imports   = ImportAvails { 
233                         imp_mods     = unitModuleEnv imp_mod [(qual_mod_name, import_all, loc)],
234                         imp_orphs    = orphans,
235                         imp_finsts   = finsts,
236                         imp_dep_mods = mkModDeps dependent_mods,
237                         imp_dep_pkgs = dependent_pkgs
238                    }
239
240         -- Complain if we import a deprecated module
241     ifOptM Opt_WarnWarningsDeprecations (
242        case warns of    
243           WarnAll txt -> addWarn (moduleWarn imp_mod_name txt)
244           _           -> return ()
245      )
246
247     let new_imp_decl = L loc (ImportDecl loc_imp_mod_name mb_pkg want_boot
248                                          qual_only as_mod new_imp_details)
249
250     return (new_imp_decl, gbl_env, imports, mi_hpc iface)
251     )
252
253 warnRedundantSourceImport :: ModuleName -> SDoc
254 warnRedundantSourceImport mod_name
255   = ptext (sLit "Unnecessary {-# SOURCE #-} in the import of module")
256           <+> quotes (ppr mod_name)
257 \end{code}
258
259
260 %************************************************************************
261 %*                                                                      *
262                 importsFromLocalDecls
263 %*                                                                      *
264 %************************************************************************
265
266 From the top-level declarations of this module produce
267         * the lexical environment
268         * the ImportAvails
269 created by its bindings.  
270         
271 Note [Shadowing in extendGlobalRdrEnvRn]
272 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
273 Usually when etending the GlobalRdrEnv we complain if a new binding
274 duplicates an existing one.  By adding the bindings one at a time, 
275 this check also complains if we add two new bindings for the same name.
276 (Remember that in Template Haskell the duplicates might *already be* 
277 in the GlobalRdrEnv from higher up the module.)
278
279 But with a Template Haskell quotation we want to *shadow*:
280         f x = h [d| f = 3 |]
281 Here the inner binding for 'f' simply shadows the outer one.
282 And that applies even if the binding for 'f' is in a where-clause,
283 and hence is in the *local* RdrEnv not the *global* RdrEnv.
284
285 Hence the shadowP boolean passed in. 
286
287 \begin{code}
288 extendGlobalRdrEnvRn :: Bool    -- Note [Shadowing in extendGlobalRdrEnvRn]
289                      -> [AvailInfo]
290                      -> MiniFixityEnv
291                      -> RnM (TcGblEnv, TcLclEnv)
292   -- Updates both the GlobalRdrEnv and the FixityEnv
293   -- We return a new TcLclEnv only becuase we might have to
294   -- delete some bindings from it; see Note [Shadowing in extendGlobalRdrEnvRn]
295
296 extendGlobalRdrEnvRn shadowP avails new_fixities
297   = do  { (gbl_env, lcl_env) <- getEnvs
298         ; let rdr_env = tcg_rdr_env gbl_env
299               fix_env = tcg_fix_env gbl_env
300
301                 -- Delete new_occs from global and local envs
302                 -- We are going to shadow them
303                 -- See Note [Shadowing in extendGlobalRdrEnvRn]
304               new_occs = map (nameOccName . gre_name) gres
305               rdr_env1 = hideSomeUnquals rdr_env new_occs
306               lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs }
307         
308                 -- Note [Shadowing in extendGlobalRdrEnvRn]
309               (rdr_env2, lcl_env2) | shadowP   = (rdr_env1, lcl_env1)
310                                    | otherwise = (rdr_env,  lcl_env)
311
312               rdr_env3 = foldl extendGlobalRdrEnv rdr_env2 gres
313               fix_env' = foldl extend_fix_env     fix_env  gres
314               (rdr_env', dups) = findLocalDupsRdrEnv rdr_env3 new_occs
315
316               gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
317               
318         ; mapM_ addDupDeclErr dups
319         
320         ; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env'))
321         ; return (gbl_env', lcl_env2) }
322   where
323     gres = gresFromAvails LocalDef avails
324
325         --  If there is a fixity decl for the gre, add it to the fixity env
326     extend_fix_env fix_env gre 
327       | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
328       = extendNameEnv fix_env name (FixItem occ fi)
329       | otherwise
330       = fix_env
331       where
332         name = gre_name gre
333         occ  = nameOccName name
334 \end{code}
335
336 @getLocalDeclBinders@ returns the names for an @HsDecl@.  It's
337 used for source code.
338
339         *** See "THE NAMING STORY" in HsDecls ****
340
341 Instances of type families
342 ~~~~~~~~~~~~~~~~~~~~~~~~~~
343 Indexed data/newtype instances contain data constructors that we need to
344 collect, too.  Moreover, we need to descend into the data/newtypes instances
345 of associated families.
346
347 We need to be careful with the handling of the type constructor of each type
348 instance as the family constructor is already defined, and we want to avoid
349 raising a duplicate declaration error.  So, we make a new name for it, but
350 don't return it in the 'AvailInfo'.
351
352 \begin{code}
353 getLocalNonValBinders :: HsGroup RdrName -> RnM [AvailInfo]
354 -- Get all the top-level binders bound the group *except* 
355 -- for value bindings, which are treated separately
356 -- Specificaly we return AvailInfo for
357 --      type decls
358 --      class decls
359 --      associated types
360 --      foreign imports
361 --      (in hs-boot files) value signatures
362
363 getLocalNonValBinders group
364   = do  { gbl_env <- getGblEnv
365         ; get_local_binders gbl_env group }
366
367 get_local_binders :: TcGblEnv -> HsGroup RdrName -> RnM [GenAvailInfo Name]
368 get_local_binders gbl_env (HsGroup {hs_valds  = ValBindsIn _ val_sigs,
369                                     hs_tyclds = tycl_decls, 
370                                     hs_instds = inst_decls,
371                                     hs_fords  = foreign_decls })
372   = do  { tc_names_s <- mapM new_tc tycl_decls
373         ; at_names_s <- mapM inst_ats inst_decls
374         ; val_names  <- mapM new_simple val_bndrs
375         ; return (val_names ++ tc_names_s ++ concat at_names_s) }
376   where
377     mod        = tcg_mod gbl_env
378     is_hs_boot = isHsBoot (tcg_src gbl_env) ;
379
380     for_hs_bndrs :: [Located RdrName]
381     for_hs_bndrs = [nm | L _ (ForeignImport nm _ _) <- foreign_decls]
382
383     -- In a hs-boot file, the value binders come from the
384     --  *signatures*, and there should be no foreign binders 
385     val_bndrs :: [Located RdrName]
386     val_bndrs | is_hs_boot = [nm | L _ (TypeSig nm _) <- val_sigs]
387               | otherwise  = for_hs_bndrs
388
389     new_simple :: Located RdrName -> RnM (GenAvailInfo Name)
390     new_simple rdr_name = do
391         nm <- newTopSrcBinder mod rdr_name
392         return (Avail nm)
393
394     new_tc tc_decl 
395       | isFamInstDecl (unLoc tc_decl)
396         = do { main_name <- lookupFamInstDeclBndr mod main_rdr
397              ; sub_names <- mapM (newTopSrcBinder mod) sub_rdrs
398              ; return (AvailTC main_name sub_names) }
399                         -- main_name is not bound here!
400       | otherwise
401         = do { main_name <- newTopSrcBinder mod main_rdr
402              ; sub_names <- mapM (newTopSrcBinder mod) sub_rdrs
403              ; return (AvailTC main_name (main_name : sub_names)) }
404       where
405         (main_rdr : sub_rdrs) = tyClDeclNames (unLoc tc_decl)
406
407     inst_ats inst_decl 
408         = mapM new_tc (instDeclATs (unLoc inst_decl))
409
410 get_local_binders _ g = pprPanic "get_local_binders" (ppr g)
411 \end{code}
412
413
414 %************************************************************************
415 %*                                                                      *
416 \subsection{Filtering imports}
417 %*                                                                      *
418 %************************************************************************
419
420 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
421 available, and filters it through the import spec (if any).
422
423 \begin{code}
424 filterImports :: ModIface
425               -> ImpDeclSpec                    -- The span for the entire import decl
426               -> Maybe (Bool, [LIE RdrName])    -- Import spec; True => hiding
427               -> [AvailInfo]                    -- What's available
428               -> RnM (Maybe (Bool, [LIE Name]), -- Import spec w/ Names
429                       GlobalRdrEnv)             -- Same again, but in GRE form
430 filterImports _ decl_spec Nothing all_avails
431   = return (Nothing, mkGlobalRdrEnv (gresFromAvails prov all_avails))
432   where
433     prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]
434
435
436 filterImports iface decl_spec (Just (want_hiding, import_items)) all_avails
437   = do   -- check for errors, convert RdrNames to Names
438         opt_typeFamilies <- doptM Opt_TypeFamilies
439         items1 <- mapM (lookup_lie opt_typeFamilies) import_items
440
441         let items2 :: [(LIE Name, AvailInfo)]
442             items2 = concat items1
443                 -- NB the AvailInfo may have duplicates, and several items
444                 --    for the same parent; e.g N(x) and N(y)
445
446             names  = availsToNameSet (map snd items2)
447             keep n = not (n `elemNameSet` names)
448             pruned_avails = filterAvails keep all_avails
449             hiding_prov = Imported [ImpSpec { is_decl = decl_spec, is_item = ImpAll }]
450
451             gres | want_hiding = gresFromAvails hiding_prov pruned_avails
452                  | otherwise   = concatMap (gresFromIE decl_spec) items2
453
454         return (Just (want_hiding, map fst items2), mkGlobalRdrEnv gres)
455   where
456         -- This environment is how we map names mentioned in the import
457         -- list to the actual Name they correspond to, and the name family
458         -- that the Name belongs to (the AvailInfo).  The situation is
459         -- complicated by associated families, which introduce a three-level
460         -- hierachy, where class = grand parent, assoc family = parent, and
461         -- data constructors = children.  The occ_env entries for associated
462         -- families needs to capture all this information; hence, we have the
463         -- third component of the environment that gives the class name (=
464         -- grand parent) in case of associated families.
465         --
466         -- This env will have entries for data constructors too,
467         -- they won't make any difference because naked entities like T
468         -- in an import list map to TcOccs, not VarOccs.
469     occ_env :: OccEnv (Name,        -- the name
470                        AvailInfo,   -- the export item providing the name
471                        Maybe Name)  -- the parent of associated types
472     occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing)) 
473                                  | a <- all_avails, n <- availNames a]
474       where
475         -- we know that (1) there are at most entries for one name, (2) their
476         -- first component is identical, (3) they are for tys/cls, and (4) one
477         -- entry has the name in its parent position (the other doesn't)
478         combine (name, AvailTC p1 subs1, Nothing)
479                 (_   , AvailTC p2 subs2, Nothing)
480           = let
481               (parent, subs) = if p1 == name then (p2, subs1) else (p1, subs2)
482             in
483             (name, AvailTC name subs, Just parent)
484         combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
485
486     lookup_lie :: Bool -> LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
487     lookup_lie opt_typeFamilies (L loc ieRdr)
488         = do 
489              stuff <- setSrcSpan loc $ 
490                       case lookup_ie opt_typeFamilies ieRdr of
491                             Failed err  -> addErr err >> return []
492                             Succeeded a -> return a
493              checkDodgyImport stuff
494              return [ (L loc ie, avail) | (ie,avail) <- stuff ]
495         where
496                 -- Warn when importing T(..) if T was exported abstractly
497             checkDodgyImport stuff
498                 | IEThingAll n <- ieRdr, (_, AvailTC _ [_]):_ <- stuff
499                 = ifOptM Opt_WarnDodgyImports (addWarn (dodgyImportWarn n))
500                 -- NB. use the RdrName for reporting the warning
501             checkDodgyImport _
502                 = return ()
503
504         -- For each import item, we convert its RdrNames to Names,
505         -- and at the same time construct an AvailInfo corresponding
506         -- to what is actually imported by this item.
507         -- Returns Nothing on error.
508         -- We return a list here, because in the case of an import
509         -- item like C, if we are hiding, then C refers to *both* a
510         -- type/class and a data constructor.  Moreover, when we import
511         -- data constructors of an associated family, we need separate
512         -- AvailInfos for the data constructors and the family (as they have
513         -- different parents).  See the discussion at occ_env.
514     lookup_ie :: Bool -> IE RdrName -> MaybeErr Message [(IE Name,AvailInfo)]
515     lookup_ie opt_typeFamilies ie 
516       = let bad_ie = Failed (badImportItemErr iface decl_spec ie)
517
518             lookup_name rdrName = 
519                 case lookupOccEnv occ_env (rdrNameOcc rdrName) of
520                    Nothing -> bad_ie
521                    Just n  -> return n
522         in
523         case ie of
524          IEVar n -> do
525              (name, avail, _) <- lookup_name n
526              return [(IEVar name, trimAvail avail name)]
527
528          IEThingAll tc -> do
529              (name, avail@(AvailTC name2 subs), mb_parent) <- lookup_name tc
530              case mb_parent of
531                -- non-associated ty/cls
532                Nothing     -> return [(IEThingAll name, avail)]
533                -- associated ty
534                Just parent -> return [(IEThingAll name, 
535                                        AvailTC name2 (subs \\ [name])),
536                                       (IEThingAll name, AvailTC parent [name])]
537
538          IEThingAbs tc
539              | want_hiding   -- hiding ( C )
540                         -- Here the 'C' can be a data constructor 
541                         --  *or* a type/class, or even both
542              -> let tc_name = lookup_name tc
543                     dc_name = lookup_name (setRdrNameSpace tc srcDataName)
544                 in
545                 case catMaybeErr [ tc_name, dc_name ] of
546                   []    -> bad_ie
547                   names -> return [mkIEThingAbs name | name <- names]
548              | otherwise
549              -> do nameAvail <- lookup_name tc
550                    return [mkIEThingAbs nameAvail]
551
552          IEThingWith tc ns -> do
553             (name, AvailTC _ subnames, mb_parent) <- lookup_name tc
554             let 
555               env         = mkOccEnv [(nameOccName s, s) | s <- subnames]
556               mb_children = map (lookupOccEnv env . rdrNameOcc) ns
557             children <- if any isNothing mb_children
558                         then bad_ie
559                         else return (catMaybes mb_children)
560               -- check for proper import of type families
561             when (not opt_typeFamilies && any isTyConName children) $
562               Failed (typeItemErr (head . filter isTyConName $ children)
563                                   (text "in import list"))
564             case mb_parent of
565                -- non-associated ty/cls
566               Nothing     -> return [(IEThingWith name children, 
567                                       AvailTC name (name:children))]
568                -- associated ty
569               Just parent -> return [(IEThingWith name children, 
570                                       AvailTC name children),
571                                      (IEThingWith name children, 
572                                       AvailTC parent [name])]
573
574          _other -> Failed illegalImportItemErr
575          -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
576          -- all errors.
577
578       where
579         mkIEThingAbs (n, av, Nothing    ) = (IEThingAbs n, trimAvail av n) 
580         mkIEThingAbs (n, _,  Just parent) = (IEThingAbs n, AvailTC parent [n]) 
581
582
583 catMaybeErr :: [MaybeErr err a] -> [a]
584 catMaybeErr ms =  [ a | Succeeded a <- ms ]
585 \end{code}
586
587 %************************************************************************
588 %*                                                                      *
589         Import/Export Utils
590 %*                                                                      *
591 %************************************************************************
592
593 \begin{code}
594 -- | make a 'GlobalRdrEnv' where all the elements point to the same
595 -- import declaration (useful for "hiding" imports, or imports with
596 -- no details).
597 gresFromAvails :: Provenance -> [AvailInfo] -> [GlobalRdrElt]
598 gresFromAvails prov avails
599   = concatMap (gresFromAvail (const prov)) avails
600
601 gresFromAvail :: (Name -> Provenance) -> AvailInfo -> [GlobalRdrElt]
602 gresFromAvail prov_fn avail
603   = [ GRE {gre_name = n, 
604            gre_par = availParent n avail, 
605            gre_prov = prov_fn n}
606     | n <- availNames avail ]
607   
608 greAvail :: GlobalRdrElt -> AvailInfo
609 greAvail gre = mkUnitAvail (gre_name gre) (gre_par gre)
610
611 mkUnitAvail :: Name -> Parent -> AvailInfo
612 mkUnitAvail me (ParentIs p)              = AvailTC p  [me]
613 mkUnitAvail me NoParent | isTyConName me = AvailTC me [me]
614                         | otherwise      = Avail me
615
616 plusAvail :: GenAvailInfo Name -> GenAvailInfo Name -> GenAvailInfo Name
617 plusAvail (Avail n1)      (Avail _)        = Avail n1
618 plusAvail (AvailTC _ ns1) (AvailTC n2 ns2) = AvailTC n2 (ns1 `unionLists` ns2)
619 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
620
621 availParent :: Name -> AvailInfo -> Parent
622 availParent _ (Avail _)                 = NoParent
623 availParent n (AvailTC m _) | n == m    = NoParent
624                             | otherwise = ParentIs m
625
626 trimAvail :: AvailInfo -> Name -> AvailInfo
627 trimAvail (Avail n)      _ = Avail n
628 trimAvail (AvailTC n ns) m = ASSERT( m `elem` ns) AvailTC n [m]
629
630 -- | filters 'AvailInfo's by the given predicate
631 filterAvails  :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
632 filterAvails keep avails = foldr (filterAvail keep) [] avails
633
634 -- | filters an 'AvailInfo' by the given predicate
635 filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
636 filterAvail keep ie rest =
637   case ie of
638     Avail n | keep n    -> ie : rest
639             | otherwise -> rest
640     AvailTC tc ns ->
641         let left = filter keep ns in
642         if null left then rest else AvailTC tc left : rest
643
644 -- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
645 gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt]
646 gresFromIE decl_spec (L loc ie, avail)
647   = gresFromAvail prov_fn avail
648   where
649     is_explicit = case ie of
650                     IEThingAll name -> \n -> n == name
651                     _               -> \_ -> True
652     prov_fn name = Imported [imp_spec]
653         where
654           imp_spec  = ImpSpec { is_decl = decl_spec, is_item = item_spec }
655           item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc }
656
657 mkChildEnv :: [GlobalRdrElt] -> NameEnv [Name]
658 mkChildEnv gres = foldr add emptyNameEnv gres
659     where
660         add (GRE { gre_name = n, gre_par = ParentIs p }) env = extendNameEnv_C (++) env p [n]
661         add _                                            env = env
662
663 findChildren :: NameEnv [Name] -> Name -> [Name]
664 findChildren env n = lookupNameEnv env n `orElse` []
665 \end{code}
666
667 ---------------------------------------
668         AvailEnv and friends
669
670 All this AvailEnv stuff is hardly used; only in a very small
671 part of RnNames.  Todo: remove?
672 ---------------------------------------
673
674 \begin{code}
675 type AvailEnv = NameEnv AvailInfo       -- Maps a Name to the AvailInfo that contains it
676
677 emptyAvailEnv :: AvailEnv
678 emptyAvailEnv = emptyNameEnv
679
680 unitAvailEnv :: AvailInfo -> AvailEnv
681 unitAvailEnv a = unitNameEnv (availName a) a
682
683 plusAvailEnv :: AvailEnv -> AvailEnv -> AvailEnv
684 plusAvailEnv = plusNameEnv_C plusAvail
685
686 availEnvElts :: AvailEnv -> [AvailInfo]
687 availEnvElts = nameEnvElts
688
689 addAvail :: AvailEnv -> AvailInfo -> AvailEnv
690 addAvail avails avail = extendNameEnv_C plusAvail avails (availName avail) avail
691
692 mkAvailEnv :: [AvailInfo] -> AvailEnv
693         -- 'avails' may have several items with the same availName
694         -- E.g  import Ix( Ix(..), index )
695         -- will give Ix(Ix,index,range) and Ix(index)
696         -- We want to combine these; addAvail does that
697 mkAvailEnv avails = foldl addAvail emptyAvailEnv avails
698
699 -- After combining the avails, we need to ensure that the parent name is the
700 -- first entry in the list of subnames, if it is included at all.  (Subsequent
701 -- functions rely on that.)
702 normaliseAvail :: AvailInfo -> AvailInfo
703 normaliseAvail avail@(Avail _)     = avail
704 normaliseAvail (AvailTC name subs) = AvailTC name subs'
705   where
706     subs' = if name `elem` subs then name : (delete name subs) else subs
707
708 -- | combines 'AvailInfo's from the same family
709 nubAvails :: [AvailInfo] -> [AvailInfo]
710 nubAvails avails = map normaliseAvail . nameEnvElts . mkAvailEnv $ avails
711 \end{code}
712
713
714 %************************************************************************
715 %*                                                                      *
716 \subsection{Export list processing}
717 %*                                                                      *
718 %************************************************************************
719
720 Processing the export list.
721
722 You might think that we should record things that appear in the export
723 list as ``occurrences'' (using @addOccurrenceName@), but you'd be
724 wrong.  We do check (here) that they are in scope, but there is no
725 need to slurp in their actual declaration (which is what
726 @addOccurrenceName@ forces).
727
728 Indeed, doing so would big trouble when compiling @PrelBase@, because
729 it re-exports @GHC@, which includes @takeMVar#@, whose type includes
730 @ConcBase.StateAndSynchVar#@, and so on...
731
732 \begin{code}
733 type ExportAccum        -- The type of the accumulating parameter of
734                         -- the main worker function in rnExports
735      = ([LIE Name],             -- Export items with Names
736         ExportOccMap,           -- Tracks exported occurrence names
737         [AvailInfo])            -- The accumulated exported stuff
738                                 --   Not nub'd!
739
740 emptyExportAccum :: ExportAccum
741 emptyExportAccum = ([], emptyOccEnv, []) 
742
743 type ExportOccMap = OccEnv (Name, IE RdrName)
744         -- Tracks what a particular exported OccName
745         --   in an export list refers to, and which item
746         --   it came from.  It's illegal to export two distinct things
747         --   that have the same occurrence name
748
749 rnExports :: Bool       -- False => no 'module M(..) where' header at all
750           -> Maybe [LIE RdrName]        -- Nothing => no explicit export list
751           -> TcGblEnv
752           -> RnM TcGblEnv
753
754         -- Complains if two distinct exports have same OccName
755         -- Warns about identical exports.
756         -- Complains about exports items not in scope
757
758 rnExports explicit_mod exports 
759           tcg_env@(TcGblEnv { tcg_mod     = this_mod,
760                               tcg_rdr_env = rdr_env, 
761                               tcg_imports = imports })
762  = do   {  
763         -- If the module header is omitted altogether, then behave
764         -- as if the user had written "module Main(main) where..."
765         -- EXCEPT in interactive mode, when we behave as if he had
766         -- written "module Main where ..."
767         -- Reason: don't want to complain about 'main' not in scope
768         --         in interactive mode
769         ; dflags <- getDOpts
770         ; let real_exports 
771                  | explicit_mod = exports
772                  | ghcLink dflags == LinkInMemory = Nothing
773                  | otherwise = Just ([noLoc (IEVar main_RDR_Unqual)])
774                         -- ToDo: the 'noLoc' here is unhelpful if 'main' 
775                         --       turns out to be out of scope
776
777         ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod
778         ; let final_avails = nubAvails avails        -- Combine families
779         
780         ; return (tcg_env { tcg_exports    = final_avails,
781                             tcg_rn_exports = case tcg_rn_exports tcg_env of
782                                                 Nothing -> Nothing
783                                                 Just _  -> rn_exports,
784                             tcg_dus = tcg_dus tcg_env `plusDU` 
785                                       usesOnly (availsToNameSet final_avails) }) }
786
787
788 exports_from_avail :: Maybe [LIE RdrName]
789                          -- Nothing => no explicit export list
790                    -> GlobalRdrEnv
791                    -> ImportAvails
792                    -> Module
793                    -> RnM (Maybe [LIE Name], [AvailInfo])
794
795 exports_from_avail Nothing rdr_env _imports _this_mod
796  = -- The same as (module M) where M is the current module name,
797    -- so that's how we handle it.
798    let
799        avails = [ greAvail gre | gre <- globalRdrEnvElts rdr_env,
800                                  isLocalGRE gre ]
801    in
802    return (Nothing, avails)
803
804 exports_from_avail (Just rdr_items) rdr_env imports this_mod
805   = do (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items
806
807        return (Just ie_names, exports)
808   where
809     do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum
810     do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)
811
812     kids_env :: NameEnv [Name]  -- Maps a parent to its in-scope children
813     kids_env = mkChildEnv (globalRdrEnvElts rdr_env)
814
815     imported_modules = [ qual_name
816                        | xs <- moduleEnvElts $ imp_mods imports,
817                          (qual_name, _, _) <- xs ]
818
819     exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
820     exports_from_item acc@(ie_names, occs, exports) 
821                       (L loc ie@(IEModuleContents mod))
822         | let earlier_mods = [ mod | (L _ (IEModuleContents mod)) <- ie_names ]
823         , mod `elem` earlier_mods       -- Duplicate export of M
824         = do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
825                warnIf warn_dup_exports (dupModuleExport mod) ;
826                return acc }
827
828         | otherwise
829         = do { implicit_prelude <- doptM Opt_ImplicitPrelude
830          ; let { exportValid = (mod `elem` imported_modules)
831                             || (moduleName this_mod == mod)
832                ; gres = filter (isModuleExported implicit_prelude mod)
833                                (globalRdrEnvElts rdr_env)
834                }
835
836          ; checkErr exportValid (moduleNotImported mod)
837              ; warnIf (exportValid && null gres) (nullModuleExport mod)
838
839              ; occs' <- check_occs ie occs (map gre_name gres)
840                       -- This check_occs not only finds conflicts
841                       -- between this item and others, but also
842                       -- internally within this item.  That is, if
843                       -- 'M.x' is in scope in several ways, we'll have
844                       -- several members of mod_avails with the same
845                       -- OccName.
846              ; return (L loc (IEModuleContents mod) : ie_names,
847                        occs', map greAvail gres ++ exports) }
848
849     exports_from_item acc@(lie_names, occs, exports) (L loc ie)
850         | isDoc ie
851         = do new_ie <- lookup_doc_ie ie
852              return (L loc new_ie : lie_names, occs, exports)
853
854         | otherwise
855         = do (new_ie, avail) <- lookup_ie ie
856              if isUnboundName (ieName new_ie)
857                   then return acc       -- Avoid error cascade
858                   else do
859
860              occs' <- check_occs ie occs (availNames avail)
861
862              return (L loc new_ie : lie_names, occs', avail : exports)
863
864     -------------
865     lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo)
866     lookup_ie (IEVar rdr) 
867         = do gre <- lookupGreRn rdr
868              return (IEVar (gre_name gre), greAvail gre)
869
870     lookup_ie (IEThingAbs rdr) 
871         = do gre <- lookupGreRn rdr
872              let name = gre_name gre
873              case gre_par gre of
874                 NoParent   -> return (IEThingAbs name, 
875                                       AvailTC name [name])
876                 ParentIs p -> return (IEThingAbs name, 
877                                       AvailTC p [name])
878
879     lookup_ie ie@(IEThingAll rdr) 
880         = do name <- lookupGlobalOccRn rdr
881              let kids = findChildren kids_env name
882              when (null kids)
883                   (if (isTyConName name) then addWarn (dodgyExportWarn name)
884                                 -- This occurs when you export T(..), but
885                                 -- only import T abstractly, or T is a synonym.  
886                    else addErr (exportItemErr ie))
887                         
888              return (IEThingAll name, AvailTC name (name:kids))
889
890     lookup_ie ie@(IEThingWith rdr sub_rdrs)
891         = do name <- lookupGlobalOccRn rdr
892              if isUnboundName name
893                 then return (IEThingWith name [], AvailTC name [name])
894                 else do
895              let env = mkOccEnv [ (nameOccName s, s) 
896                                 | s <- findChildren kids_env name ]
897                  mb_names = map (lookupOccEnv env . rdrNameOcc) sub_rdrs
898              if any isNothing mb_names
899                 then do addErr (exportItemErr ie)
900                         return (IEThingWith name [], AvailTC name [name])
901                 else do let names = catMaybes mb_names
902                         optTyFam <- doptM Opt_TypeFamilies
903                         when (not optTyFam && any isTyConName names) $
904                           addErr (typeItemErr ( head
905                                               . filter isTyConName 
906                                               $ names )
907                                               (text "in export list"))
908                         return (IEThingWith name names, AvailTC name (name:names))
909
910     lookup_ie _ = panic "lookup_ie"     -- Other cases covered earlier
911
912     -------------
913     lookup_doc_ie :: IE RdrName -> RnM (IE Name)
914     lookup_doc_ie (IEGroup lev doc) = do rn_doc <- rnHsDoc doc
915                                          return (IEGroup lev rn_doc)
916     lookup_doc_ie (IEDoc doc)       = do rn_doc <- rnHsDoc doc
917                                          return (IEDoc rn_doc)
918     lookup_doc_ie (IEDocNamed str)  = return (IEDocNamed str)
919     lookup_doc_ie _ = panic "lookup_doc_ie"     -- Other cases covered earlier
920
921
922 isDoc :: IE RdrName -> Bool
923 isDoc (IEDoc _)      = True
924 isDoc (IEDocNamed _) = True
925 isDoc (IEGroup _ _)  = True
926 isDoc _ = False
927
928 -------------------------------
929 isModuleExported :: Bool -> ModuleName -> GlobalRdrElt -> Bool
930 -- True if the thing is in scope *both* unqualified, *and* with qualifier M
931 isModuleExported implicit_prelude mod (GRE { gre_name = name, gre_prov = prov })
932   | implicit_prelude && isBuiltInSyntax name = False
933         -- Optimisation: filter out names for built-in syntax
934         -- They just clutter up the environment (esp tuples), and the parser
935         -- will generate Exact RdrNames for them, so the cluttered
936         -- envt is no use.  To avoid doing this filter all the time,
937         -- we use -XNoImplicitPrelude as a clue that the filter is
938         -- worth while.  Really, it's only useful for GHC.Base and GHC.Tuple.
939         --
940         -- It's worth doing because it makes the environment smaller for
941         -- every module that imports the Prelude
942   | otherwise
943   = case prov of
944         LocalDef    -> moduleName (nameModule name) == mod
945         Imported is -> any unQualSpecOK is && any (qualSpecOK mod) is
946
947 -------------------------------
948 check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap
949 check_occs ie occs names
950   = foldlM check occs names
951   where
952     check occs name
953       = case lookupOccEnv occs name_occ of
954           Nothing -> return (extendOccEnv occs name_occ (name, ie))
955
956           Just (name', ie') 
957             | name == name'     -- Duplicate export
958             ->  do { warn_dup_exports <- doptM Opt_WarnDuplicateExports ;
959                      warnIf warn_dup_exports (dupExportWarn name_occ ie ie') ;
960                      return occs }
961
962             | otherwise         -- Same occ name but different names: an error
963             ->  do { global_env <- getGlobalRdrEnv ;
964                      addErr (exportClashErr global_env name' name ie' ie) ;
965                      return occs }
966       where
967         name_occ = nameOccName name
968 \end{code}
969
970 %*********************************************************
971 %*                                                       *
972                 Deprecations
973 %*                                                       *
974 %*********************************************************
975
976 \begin{code}
977 finishWarnings :: DynFlags -> Maybe WarningTxt 
978                -> TcGblEnv -> RnM TcGblEnv
979 -- (a) Report usage of imports that are deprecated or have other warnings
980 -- (b) If the whole module is warned about or deprecated, update tcg_warns
981 --     All this happens only once per module
982 finishWarnings dflags mod_warn tcg_env
983   = do  { (eps,hpt) <- getEpsAndHpt
984         ; ifOptM Opt_WarnWarningsDeprecations $
985           mapM_ (check hpt (eps_PIT eps)) all_gres
986                 -- By this time, typechecking is complete, 
987                 -- so the PIT is fully populated
988
989         -- Deal with a module deprecation; it overrides all existing warns
990         ; let new_warns = case mod_warn of
991                                 Just txt -> WarnAll txt
992                                 Nothing  -> tcg_warns tcg_env
993         ; return (tcg_env { tcg_warns = new_warns }) }
994   where
995     used_names = allUses (tcg_dus tcg_env) 
996         -- Report on all deprecated uses; hence allUses
997     all_gres   = globalRdrEnvElts (tcg_rdr_env tcg_env)
998
999     check hpt pit gre@(GRE {gre_name = name, gre_prov = Imported (imp_spec:_)})
1000       | name `elemNameSet` used_names
1001       , Just deprec_txt <- lookupImpDeprec dflags hpt pit gre
1002       = addWarnAt (importSpecLoc imp_spec)
1003                   (sep [ptext (sLit "In the use of") <+> 
1004                         pprNonVarNameSpace (occNameSpace (nameOccName name)) <+> 
1005                         quotes (ppr name),
1006                       (parens imp_msg) <> colon,
1007                       (ppr deprec_txt) ])
1008         where
1009           name_mod = nameModule name
1010           imp_mod  = importSpecModule imp_spec
1011           imp_msg  = ptext (sLit "imported from") <+> ppr imp_mod <> extra
1012           extra | imp_mod == moduleName name_mod = empty
1013                 | otherwise = ptext (sLit ", but defined in") <+> ppr name_mod
1014
1015     check _ _ _ = return ()     -- Local, or not used, or not deprectated
1016             -- The Imported pattern-match: don't deprecate locally defined names
1017             -- For a start, we may be exporting a deprecated thing
1018             -- Also we may use a deprecated thing in the defn of another
1019             -- deprecated things.  We may even use a deprecated thing in
1020             -- the defn of a non-deprecated thing, when changing a module's 
1021             -- interface
1022
1023 lookupImpDeprec :: DynFlags -> HomePackageTable -> PackageIfaceTable 
1024                 -> GlobalRdrElt -> Maybe WarningTxt
1025 -- The name is definitely imported, so look in HPT, PIT
1026 lookupImpDeprec dflags hpt pit gre
1027   = case lookupIfaceByModule dflags hpt pit (nameModule name) of
1028         Just iface -> mi_warn_fn iface name `mplus`     -- Bleat if the thing, *or
1029                       case gre_par gre of       
1030                         ParentIs p -> mi_warn_fn iface p        -- its parent*, is warn'd
1031                         NoParent   -> Nothing
1032
1033         Nothing -> Nothing      -- See Note [Used names with interface not loaded]
1034   where
1035         name = gre_name gre
1036 \end{code}
1037
1038 Note [Used names with interface not loaded]
1039 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1040 By now all the interfaces should have been loaded,
1041 because reportDeprecations happens after typechecking.
1042 However, it's still (just) possible to to find a used 
1043 Name whose interface hasn't been loaded:
1044
1045 a) It might be a WiredInName; in that case we may not load 
1046    its interface (although we could).
1047
1048 b) It might be GHC.Real.fromRational, or GHC.Num.fromInteger
1049    These are seen as "used" by the renamer (if -XNoImplicitPrelude) 
1050    is on), but the typechecker may discard their uses 
1051    if in fact the in-scope fromRational is GHC.Read.fromRational,
1052    (see tcPat.tcOverloadedLit), and the typechecker sees that the type 
1053    is fixed, say, to GHC.Base.Float (see Inst.lookupSimpleInst).
1054    In that obscure case it won't force the interface in.
1055
1056 In both cases we simply don't permit deprecations; 
1057 this is, after all, wired-in stuff.
1058
1059
1060 %*********************************************************
1061 %*                                                       *
1062                 Unused names
1063 %*                                                       *
1064 %*********************************************************
1065
1066 \begin{code}
1067 reportUnusedNames :: Maybe [LIE RdrName]        -- Export list
1068                   -> TcGblEnv -> RnM ()
1069 reportUnusedNames export_decls gbl_env 
1070   = do  { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
1071         ; warnUnusedTopBinds   unused_locals
1072         ; warnUnusedModules    unused_imp_mods
1073         ; warnUnusedImports    unused_imports   
1074         ; warnDuplicateImports defined_and_used
1075         ; printMinimalImports  minimal_imports }
1076   where
1077     used_names :: NameSet
1078     used_names = findUses (tcg_dus gbl_env) emptyNameSet
1079         -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
1080         -- Hence findUses
1081
1082         -- Collect the defined names from the in-scope environment
1083     defined_names :: [GlobalRdrElt]
1084     defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
1085
1086         -- Note that defined_and_used, defined_but_not_used
1087         -- are both [GRE]; that's why we need defined_and_used
1088         -- rather than just used_names
1089     defined_and_used, defined_but_not_used :: [GlobalRdrElt]
1090     (defined_and_used, defined_but_not_used) 
1091         = partition (gre_is_used used_names) defined_names
1092     
1093     kids_env = mkChildEnv defined_names
1094         -- This is done in mkExports too; duplicated work
1095
1096     gre_is_used :: NameSet -> GlobalRdrElt -> Bool
1097     gre_is_used used_names (GRE {gre_name = name})
1098         = name `elemNameSet` used_names
1099           || any (`elemNameSet` used_names) (findChildren kids_env name)
1100                 -- A use of C implies a use of T,
1101                 -- if C was brought into scope by T(..) or T(C)
1102
1103         -- Filter out the ones that are 
1104         --  (a) defined in this module, and
1105         --  (b) not defined by a 'deriving' clause 
1106         -- The latter have an Internal Name, so we can filter them out easily
1107     unused_locals :: [GlobalRdrElt]
1108     unused_locals = filter is_unused_local defined_but_not_used
1109     is_unused_local :: GlobalRdrElt -> Bool
1110     is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
1111     
1112     unused_imports :: [GlobalRdrElt]    
1113     unused_imports = mapCatMaybes unused_imp defined_but_not_used
1114     unused_imp :: GlobalRdrElt -> Maybe GlobalRdrElt    -- Result has trimmed Imported provenances
1115     unused_imp (GRE {gre_prov = LocalDef}) = Nothing
1116     unused_imp gre@(GRE {gre_prov = Imported imp_specs}) 
1117         | null trimmed_specs = Nothing
1118         | otherwise          = Just (gre {gre_prov = Imported trimmed_specs})
1119         where
1120           trimmed_specs = filter report_if_unused imp_specs
1121     
1122     -- To figure out the minimal set of imports, start with the things
1123     -- that are in scope (i.e. in gbl_env).  Then just combine them
1124     -- into a bunch of avails, so they are properly grouped
1125     --
1126     -- BUG WARNING: this does not deal properly with qualified imports!
1127     minimal_imports :: FiniteMap ModuleName AvailEnv
1128     minimal_imports0 = foldr add_expall   emptyFM          expall_mods
1129     minimal_imports1 = foldr add_name     minimal_imports0 defined_and_used
1130     minimal_imports  = foldr add_inst_mod minimal_imports1 direct_import_mods
1131         -- The last line makes sure that we retain all direct imports
1132         -- even if we import nothing explicitly.
1133         -- It's not necessarily redundant to import such modules. Consider 
1134         --            module This
1135         --              import M ()
1136         --
1137         -- The import M() is not *necessarily* redundant, even if
1138         -- we suck in no instance decls from M (e.g. it contains 
1139         -- no instance decls, or This contains no code).  It may be 
1140         -- that we import M solely to ensure that M's orphan instance 
1141         -- decls (or those in its imports) are visible to people who 
1142         -- import This.  Sigh. 
1143         -- There's really no good way to detect this, so the error message 
1144         -- in RnEnv.warnUnusedModules is weakened instead
1145     
1146         -- We've carefully preserved the provenance so that we can
1147         -- construct minimal imports that import the name by (one of)
1148         -- the same route(s) as the programmer originally did.
1149     add_name gre@(GRE {gre_prov = Imported (imp_spec:_)}) acc 
1150         = addToFM_C plusAvailEnv acc 
1151                     (importSpecModule imp_spec) (unitAvailEnv (greAvail gre))
1152     add_name _ acc = acc        -- Local
1153
1154         -- Modules mentioned as 'module M' in the export list
1155     expall_mods = case export_decls of
1156                     Nothing -> []
1157                     Just es -> [m | L _ (IEModuleContents m) <- es]
1158
1159         -- This is really bogus.  The idea is that if we see 'module M' in 
1160         -- the export list we must retain the import decls that drive it
1161         -- If we aren't careful we might see
1162         --      module A( module M ) where
1163         --        import M
1164         --        import N
1165         -- and suppose that N exports everything that M does.  Then we 
1166         -- must not drop the import of M even though N brings it all into
1167         -- scope.
1168         --
1169         -- BUG WARNING: 'module M' exports aside, what if M.x is mentioned?!
1170         --
1171         -- The reason that add_expall is bogus is that it doesn't take
1172         -- qualified imports into account.  But it's an improvement.
1173     add_expall mod acc = addToFM_C plusAvailEnv acc mod emptyAvailEnv
1174
1175     add_inst_mod (mod, _) acc 
1176       | mod_name `elemFM` acc = acc     -- We import something already
1177       | otherwise             = addToFM acc mod_name emptyAvailEnv
1178       where
1179         mod_name = moduleName mod
1180         -- Add an empty collection of imports for a module
1181         -- from which we have sucked only instance decls
1182    
1183     imports = tcg_imports gbl_env
1184
1185     direct_import_mods :: [(Module, [(ModuleName, Bool, SrcSpan)])]
1186         -- See the type of the imp_mods for this triple
1187     direct_import_mods = fmToList (imp_mods imports)
1188
1189     -- unused_imp_mods are the directly-imported modules 
1190     -- that are not mentioned in minimal_imports1
1191     -- [Note: not 'minimal_imports', because that includes directly-imported
1192     --        modules even if we use nothing from them; see notes above]
1193     --
1194     -- BUG WARNING: this code is generally buggy
1195     unused_imp_mods :: [(ModuleName, SrcSpan)]
1196     unused_imp_mods = [(mod_name,loc)
1197                     | (mod, xs) <- direct_import_mods,
1198                       (_, no_imp, loc) <- xs,
1199                        let mod_name = moduleName mod,
1200                        not (mod_name `elemFM` minimal_imports1),
1201                        moduleName mod /= pRELUDE_NAME,
1202                              -- XXX not really correct, but we don't want
1203                              -- to generate warnings when compiling against
1204                              -- a compat version of base.
1205                        not no_imp]
1206         -- The not no_imp part is not to complain about
1207         -- import M (), which is an idiom for importing
1208         -- instance declarations
1209     
1210     module_unused :: ModuleName -> Bool
1211     module_unused mod = any (((==) mod) . fst) unused_imp_mods
1212
1213     report_if_unused :: ImportSpec -> Bool
1214         -- Do we want to report this as an unused import?  
1215     report_if_unused (ImpSpec {is_decl = d, is_item = i})
1216         = not (module_unused (is_mod d)) -- Not if we've already said entire import is unused
1217           && isExplicitItem i            -- Only if the import was explicit
1218                         
1219 ---------------------
1220 warnDuplicateImports :: [GlobalRdrElt] -> RnM ()
1221 -- Given the GREs for names that are used, figure out which imports 
1222 -- could be omitted without changing the top-level environment.
1223 --
1224 -- NB: Given import Foo( T )
1225 --           import qualified Foo
1226 -- we do not report a duplicate import, even though Foo.T is brought
1227 -- into scope by both, because there's nothing you can *omit* without
1228 -- changing the top-level environment.  So we complain only if it's
1229 -- explicitly named in both imports or neither.
1230 --
1231 -- Furthermore, we complain about Foo.T only if 
1232 -- there is no complaint about (unqualified) T
1233
1234 warnDuplicateImports gres
1235   = ifOptM Opt_WarnUnusedImports $ 
1236     sequence_   [ warn name pr
1237                 | GRE { gre_name = name, gre_prov = Imported imps } <- gres
1238                 , pr <- redundants imps ]
1239   where
1240     warn name (red_imp, cov_imp)
1241         = addWarnAt (importSpecLoc red_imp)
1242             (vcat [ptext (sLit "Redundant import of:") <+> quotes pp_name,
1243                    ptext (sLit "It is also") <+> ppr cov_imp])
1244         where
1245           pp_name | is_qual red_decl = ppr (is_as red_decl) <> dot <> ppr occ
1246                   | otherwise       = ppr occ
1247           occ = nameOccName name
1248           red_decl = is_decl red_imp
1249     
1250     redundants :: [ImportSpec] -> [(ImportSpec,ImportSpec)]
1251         -- The returned pair is (redundant-import, covering-import)
1252     redundants imps 
1253         = [ (red_imp, cov_imp) 
1254           | red_imp <- imps
1255           , isExplicitItem (is_item red_imp)
1256                 -- Complain only about redundant imports
1257                 -- mentioned explicitly by the user                             
1258           , cov_imp <- take 1 (filter (covers red_imp) imps) ]
1259                         -- The 'take 1' picks the first offending group
1260                         -- for this particular name
1261
1262         -- "red_imp" is a putative redundant import
1263         -- "cov_imp" potentially covers it
1264         -- This test decides whether red_imp could be dropped 
1265         --
1266         -- NOTE: currently the test does not warn about
1267         --              import M( x )
1268         --              import N( x )
1269         -- even if the same underlying 'x' is involved, because dropping
1270         -- either import would change the qualified names in scope (M.x, N.x)
1271         -- But if the qualified names aren't used, the import is indeed redundant
1272         -- Sadly we don't know that.  Oh well.
1273     covers red_imp@(ImpSpec { is_decl = red_decl }) 
1274            cov_imp@(ImpSpec { is_decl = cov_decl, is_item = cov_item })
1275         | red_loc == cov_loc
1276         = False         -- Ignore diagonal elements
1277         | not (is_as red_decl == is_as cov_decl)
1278         = False         -- They bring into scope different qualified names
1279         | not (is_qual red_decl) && is_qual cov_decl
1280         = False         -- Covering one doesn't bring unqualified name into scope
1281         | otherwise
1282         = not (isExplicitItem cov_item) -- Redundant one is selective and covering one isn't
1283           || red_later                  -- or both are explicit; tie-break using red_later
1284 {-
1285         | red_selective
1286         = not cov_selective     -- Redundant one is selective and covering one isn't
1287           || red_later          -- Both are explicit; tie-break using red_later
1288         | otherwise             
1289         = not cov_selective     -- Neither import is selective
1290           && (is_mod red_decl == is_mod cov_decl)       -- They import the same module
1291           && red_later          -- Tie-break
1292 -}
1293         where
1294           red_loc   = importSpecLoc red_imp
1295           cov_loc   = importSpecLoc cov_imp
1296           red_later = red_loc > cov_loc
1297
1298 -- ToDo: deal with original imports with 'qualified' and 'as M' clauses
1299 printMinimalImports :: FiniteMap ModuleName AvailEnv    -- Minimal imports
1300                     -> RnM ()
1301 printMinimalImports imps
1302  = ifOptM Opt_D_dump_minimal_imports $ do {
1303
1304    mod_ies  <-  initIfaceTcRn $ mapM to_ies (fmToList imps) ;
1305    this_mod <- getModule ;
1306    rdr_env  <- getGlobalRdrEnv ;
1307    dflags   <- getDOpts ;
1308    liftIO $ do h <- openFile (mkFilename this_mod) WriteMode
1309                printForUser h (mkPrintUnqualified dflags rdr_env)
1310                               (vcat (map ppr_mod_ie mod_ies))
1311    }
1312   where
1313     mkFilename this_mod = moduleNameString (moduleName this_mod) ++ ".imports"
1314     ppr_mod_ie (mod_name, ies) 
1315         | mod_name == moduleName pRELUDE
1316         = empty
1317         | null ies      -- Nothing except instances comes from here
1318         = ptext (sLit "import") <+> ppr mod_name <> ptext (sLit "()    -- Instances only")
1319         | otherwise
1320         = ptext (sLit "import") <+> ppr mod_name <> 
1321                     parens (fsep (punctuate comma (map ppr ies)))
1322
1323     to_ies (mod, avail_env) = do ies <- mapM to_ie (availEnvElts avail_env)
1324                                  return (mod, ies)
1325
1326     to_ie :: AvailInfo -> IfG (IE Name)
1327         -- The main trick here is that if we're importing all the constructors
1328         -- we want to say "T(..)", but if we're importing only a subset we want
1329         -- to say "T(A,B,C)".  So we have to find out what the module exports.
1330     to_ie (Avail n)       = return (IEVar n)
1331     to_ie (AvailTC n [m]) = ASSERT( n==m ) 
1332                             return (IEThingAbs n)
1333     to_ie (AvailTC n ns)  = do
1334           iface <- loadSysInterface doc n_mod
1335           case [xs | (m,as) <- mi_exports iface,
1336                      m == n_mod,
1337                      AvailTC x xs <- as, 
1338                      x == nameOccName n] of
1339               [xs] | all_used xs -> return (IEThingAll n)
1340                    | otherwise   -> return (IEThingWith n (filter (/= n) ns))
1341               other              -> pprTrace "to_ie" (ppr n <+> ppr n_mod <+> ppr other) $
1342                                     return (IEVar n)
1343         where
1344           all_used avail_occs = all (`elem` map nameOccName ns) avail_occs
1345           doc = text "Compute minimal imports from" <+> ppr n
1346           n_mod = nameModule n
1347 \end{code}
1348
1349
1350 %************************************************************************
1351 %*                                                                      *
1352 \subsection{Errors}
1353 %*                                                                      *
1354 %************************************************************************
1355
1356 \begin{code}
1357 badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
1358 badImportItemErr iface decl_spec ie
1359   = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
1360          ptext (sLit "does not export"), quotes (ppr ie)]
1361   where
1362     source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
1363                   | otherwise     = empty
1364
1365 illegalImportItemErr :: SDoc
1366 illegalImportItemErr = ptext (sLit "Illegal import item")
1367
1368 dodgyImportWarn :: RdrName -> SDoc
1369 dodgyImportWarn item = dodgyMsg (ptext (sLit "import")) item
1370 dodgyExportWarn :: Name -> SDoc
1371 dodgyExportWarn item = dodgyMsg (ptext (sLit "export")) item
1372
1373 dodgyMsg :: OutputableBndr n => SDoc -> n -> SDoc
1374 dodgyMsg kind tc
1375   = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item") <+> quotes (ppr (IEThingAll tc)),
1376           ptext (sLit "suggests that") <+> quotes (ppr tc) <+> ptext (sLit "has constructors or class methods,"),
1377           ptext (sLit "but it has none") ]
1378
1379 exportItemErr :: IE RdrName -> SDoc
1380 exportItemErr export_item
1381   = sep [ ptext (sLit "The export item") <+> quotes (ppr export_item),
1382           ptext (sLit "attempts to export constructors or class methods that are not visible here") ]
1383
1384 typeItemErr :: Name -> SDoc -> SDoc
1385 typeItemErr name wherestr
1386   = sep [ ptext (sLit "Using 'type' tag on") <+> quotes (ppr name) <+> wherestr,
1387           ptext (sLit "Use -XTypeFamilies to enable this extension") ]
1388
1389 exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName
1390                -> Message
1391 exportClashErr global_env name1 name2 ie1 ie2
1392   = vcat [ ptext (sLit "Conflicting exports for") <+> quotes (ppr occ) <> colon
1393          , ppr_export ie1' name1'
1394          , ppr_export ie2' name2' ]
1395   where
1396     occ = nameOccName name1
1397     ppr_export ie name = nest 2 (quotes (ppr ie) <+> ptext (sLit "exports") <+> 
1398                                  quotes (ppr name) <+> pprNameProvenance (get_gre name))
1399
1400         -- get_gre finds a GRE for the Name, so that we can show its provenance
1401     get_gre name
1402         = case lookupGRE_Name global_env name of
1403              (gre:_) -> gre
1404              []      -> pprPanic "exportClashErr" (ppr name)
1405     get_loc name = nameSrcLoc $ gre_name $ get_gre name
1406     (name1', ie1', name2', ie2') = if get_loc name1 < get_loc name2
1407                                    then (name1, ie1, name2, ie2)
1408                                    else (name2, ie2, name1, ie1)
1409
1410 addDupDeclErr :: [Name] -> TcRn ()
1411 addDupDeclErr []
1412   = panic "addDupDeclErr: empty list"
1413 addDupDeclErr names@(name : _)
1414   = addErrAt (getSrcSpan (last sorted_names)) $
1415         -- Report the error at the later location
1416     vcat [ptext (sLit "Multiple declarations of") <+> quotes (ppr name),
1417           ptext (sLit "Declared at:") <+> vcat (map (ppr . nameSrcLoc) sorted_names)]
1418   where
1419     sorted_names = sortWith nameSrcLoc names
1420
1421 dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc
1422 dupExportWarn occ_name ie1 ie2
1423   = hsep [quotes (ppr occ_name), 
1424           ptext (sLit "is exported by"), quotes (ppr ie1),
1425           ptext (sLit "and"),            quotes (ppr ie2)]
1426
1427 dupModuleExport :: ModuleName -> SDoc
1428 dupModuleExport mod
1429   = hsep [ptext (sLit "Duplicate"),
1430           quotes (ptext (sLit "Module") <+> ppr mod), 
1431           ptext (sLit "in export list")]
1432
1433 moduleNotImported :: ModuleName -> SDoc
1434 moduleNotImported mod
1435   = ptext (sLit "The export item `module") <+> ppr mod <>
1436     ptext (sLit "' is not imported")
1437
1438 nullModuleExport :: ModuleName -> SDoc
1439 nullModuleExport mod
1440   = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing")
1441
1442 moduleWarn :: ModuleName -> WarningTxt -> SDoc
1443 moduleWarn mod (WarningTxt txt)
1444   = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"), 
1445           nest 4 (ppr txt) ]
1446 moduleWarn mod (DeprecatedTxt txt)
1447   = sep [ ptext (sLit "Module") <+> quotes (ppr mod)
1448                                 <+> ptext (sLit "is deprecated:"), 
1449           nest 4 (ppr txt) ]
1450
1451 implicitPreludeWarn :: SDoc
1452 implicitPreludeWarn
1453   = ptext (sLit "Module `Prelude' implicitly imported")
1454
1455 packageImportErr :: SDoc
1456 packageImportErr
1457   = ptext (sLit "Package-qualified imports are not enabled; use -XPackageImports")
1458 \end{code}