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