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