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