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