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