32f0f9420f32989c3f3706c3b7e4c77617f0cb6d
[ghc.git] / compiler / rename / RnNames.hs
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
7 {-# LANGUAGE CPP, NondecreasingIndentation #-}
8
9 module RnNames (
10 rnImports, getLocalNonValBinders, newRecordSelector,
11 rnExports, extendGlobalRdrEnvRn,
12 gresFromAvails,
13 calculateAvails,
14 reportUnusedNames,
15 checkConName
16 ) where
17
18 #include "HsVersions.h"
19
20 import DynFlags
21 import HsSyn
22 import TcEnv
23 import RnEnv
24 import RnHsDoc ( rnHsDoc )
25 import LoadIface ( loadSrcInterface )
26 import TcRnMonad
27 import PrelNames
28 import Module
29 import Name
30 import NameEnv
31 import NameSet
32 import Avail
33 import FieldLabel
34 import HscTypes
35 import RdrName
36 import RdrHsSyn ( setRdrNameSpace )
37 import Outputable
38 import Maybes
39 import SrcLoc
40 import BasicTypes ( TopLevelFlag(..), StringLiteral(..) )
41 import ErrUtils
42 import Util
43 import FastString
44 import FastStringEnv
45 import ListSetOps
46
47 import Control.Monad
48 import Data.Either ( partitionEithers, isRight, rights )
49 -- import qualified Data.Foldable as Foldable
50 import Data.Map ( Map )
51 import qualified Data.Map as Map
52 import Data.Ord ( comparing )
53 import Data.List ( partition, (\\), find, sortBy )
54 -- import qualified Data.Set as Set
55 import System.FilePath ((</>))
56 import System.IO
57
58 {-
59 ************************************************************************
60 * *
61 \subsection{rnImports}
62 * *
63 ************************************************************************
64
65 Note [Tracking Trust Transitively]
66 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
67 When we import a package as well as checking that the direct imports are safe
68 according to the rules outlined in the Note [HscMain . Safe Haskell Trust Check]
69 we must also check that these rules hold transitively for all dependent modules
70 and packages. Doing this without caching any trust information would be very
71 slow as we would need to touch all packages and interface files a module depends
72 on. To avoid this we make use of the property that if a modules Safe Haskell
73 mode changes, this triggers a recompilation from that module in the dependcy
74 graph. So we can just worry mostly about direct imports.
75
76 There is one trust property that can change for a package though without
77 recompliation being triggered: package trust. So we must check that all
78 packages a module tranitively depends on to be trusted are still trusted when
79 we are compiling this module (as due to recompilation avoidance some modules
80 below may not be considered trusted any more without recompilation being
81 triggered).
82
83 We handle this by augmenting the existing transitive list of packages a module M
84 depends on with a bool for each package that says if it must be trusted when the
85 module M is being checked for trust. This list of trust required packages for a
86 single import is gathered in the rnImportDecl function and stored in an
87 ImportAvails data structure. The union of these trust required packages for all
88 imports is done by the rnImports function using the combine function which calls
89 the plusImportAvails function that is a union operation for the ImportAvails
90 type. This gives us in an ImportAvails structure all packages required to be
91 trusted for the module we are currently compiling. Checking that these packages
92 are still trusted (and that direct imports are trusted) is done in
93 HscMain.checkSafeImports.
94
95 See the note below, [Trust Own Package] for a corner case in this method and
96 how its handled.
97
98
99 Note [Trust Own Package]
100 ~~~~~~~~~~~~~~~~~~~~~~~~
101 There is a corner case of package trust checking that the usual transitive check
102 doesn't cover. (For how the usual check operates see the Note [Tracking Trust
103 Transitively] below). The case is when you import a -XSafe module M and M
104 imports a -XTrustworthy module N. If N resides in a different package than M,
105 then the usual check works as M will record a package dependency on N's package
106 and mark it as required to be trusted. If N resides in the same package as M
107 though, then importing M should require its own package be trusted due to N
108 (since M is -XSafe so doesn't create this requirement by itself). The usual
109 check fails as a module doesn't record a package dependency of its own package.
110 So instead we now have a bool field in a modules interface file that simply
111 states if the module requires its own package to be trusted. This field avoids
112 us having to load all interface files that the module depends on to see if one
113 is trustworthy.
114
115
116 Note [Trust Transitive Property]
117 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
118 So there is an interesting design question in regards to transitive trust
119 checking. Say I have a module B compiled with -XSafe. B is dependent on a bunch
120 of modules and packages, some packages it requires to be trusted as its using
121 -XTrustworthy modules from them. Now if I have a module A that doesn't use safe
122 haskell at all and simply imports B, should A inherit all the the trust
123 requirements from B? Should A now also require that a package p is trusted since
124 B required it?
125
126 We currently say no but saying yes also makes sense. The difference is, if a
127 module M that doesn't use Safe Haskell imports a module N that does, should all
128 the trusted package requirements be dropped since M didn't declare that it cares
129 about Safe Haskell (so -XSafe is more strongly associated with the module doing
130 the importing) or should it be done still since the author of the module N that
131 uses Safe Haskell said they cared (so -XSafe is more strongly associated with
132 the module that was compiled that used it).
133
134 Going with yes is a simpler semantics we think and harder for the user to stuff
135 up but it does mean that Safe Haskell will affect users who don't care about
136 Safe Haskell as they might grab a package from Cabal which uses safe haskell (say
137 network) and that packages imports -XTrustworthy modules from another package
138 (say bytestring), so requires that package is trusted. The user may now get
139 compilation errors in code that doesn't do anything with Safe Haskell simply
140 because they are using the network package. They will have to call 'ghc-pkg
141 trust network' to get everything working. Due to this invasive nature of going
142 with yes we have gone with no for now.
143 -}
144
145 -- | Process Import Decls. See 'rnImportDecl' for a description of what
146 -- the return types represent.
147 -- Note: Do the non SOURCE ones first, so that we get a helpful warning
148 -- for SOURCE ones that are unnecessary
149 rnImports :: [LImportDecl RdrName]
150 -> RnM ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
151 rnImports imports = do
152 this_mod <- getModule
153 let (source, ordinary) = partition is_source_import imports
154 is_source_import d = ideclSource (unLoc d)
155 stuff1 <- mapAndReportM (rnImportDecl this_mod) ordinary
156 stuff2 <- mapAndReportM (rnImportDecl this_mod) source
157 -- Safe Haskell: See Note [Tracking Trust Transitively]
158 let (decls, rdr_env, imp_avails, hpc_usage) = combine (stuff1 ++ stuff2)
159 return (decls, rdr_env, imp_avails, hpc_usage)
160
161 where
162 combine :: [(LImportDecl Name, GlobalRdrEnv, ImportAvails, AnyHpcUsage)]
163 -> ([LImportDecl Name], GlobalRdrEnv, ImportAvails, AnyHpcUsage)
164 combine = foldr plus ([], emptyGlobalRdrEnv, emptyImportAvails, False)
165
166 plus (decl, gbl_env1, imp_avails1,hpc_usage1)
167 (decls, gbl_env2, imp_avails2,hpc_usage2)
168 = ( decl:decls,
169 gbl_env1 `plusGlobalRdrEnv` gbl_env2,
170 imp_avails1 `plusImportAvails` imp_avails2,
171 hpc_usage1 || hpc_usage2 )
172
173 -- | Given a located import declaration @decl@ from @this_mod@,
174 -- calculate the following pieces of information:
175 --
176 -- 1. An updated 'LImportDecl', where all unresolved 'RdrName' in
177 -- the entity lists have been resolved into 'Name's,
178 --
179 -- 2. A 'GlobalRdrEnv' representing the new identifiers that were
180 -- brought into scope (taking into account module qualification
181 -- and hiding),
182 --
183 -- 3. 'ImportAvails' summarizing the identifiers that were imported
184 -- by this declaration, and
185 --
186 -- 4. A boolean 'AnyHpcUsage' which is true if the imported module
187 -- used HPC.
188 rnImportDecl :: Module -> LImportDecl RdrName
189 -> RnM (LImportDecl Name, GlobalRdrEnv, ImportAvails, AnyHpcUsage)
190 rnImportDecl this_mod
191 (L loc decl@(ImportDecl { ideclName = loc_imp_mod_name, ideclPkgQual = mb_pkg
192 , ideclSource = want_boot, ideclSafe = mod_safe
193 , ideclQualified = qual_only, ideclImplicit = implicit
194 , ideclAs = as_mod, ideclHiding = imp_details }))
195 = setSrcSpan loc $ do
196
197 when (isJust mb_pkg) $ do
198 pkg_imports <- xoptM Opt_PackageImports
199 when (not pkg_imports) $ addErr packageImportErr
200
201 -- If there's an error in loadInterface, (e.g. interface
202 -- file not found) we get lots of spurious errors from 'filterImports'
203 let imp_mod_name = unLoc loc_imp_mod_name
204 doc = ppr imp_mod_name <+> ptext (sLit "is directly imported")
205
206 -- Check for self-import, which confuses the typechecker (Trac #9032)
207 -- ghc --make rejects self-import cycles already, but batch-mode may not
208 -- at least not until TcIface.tcHiBootIface, which is too late to avoid
209 -- typechecker crashes. (Indirect self imports are not caught until
210 -- TcIface, see #10337 tracking how to make this error better.)
211 --
212 -- Originally, we also allowed 'import {-# SOURCE #-} M', but this
213 -- caused bug #10182: in one-shot mode, we should never load an hs-boot
214 -- file for the module we are compiling into the EPS. In principle,
215 -- it should be possible to support this mode of use, but we would have to
216 -- extend Provenance to support a local definition in a qualified location.
217 -- For now, we don't support it, but see #10336
218 when (imp_mod_name == moduleName this_mod &&
219 (case mb_pkg of -- If we have import "<pkg>" M, then we should
220 -- check that "<pkg>" is "this" (which is magic)
221 -- or the name of this_mod's package. Yurgh!
222 -- c.f. GHC.findModule, and Trac #9997
223 Nothing -> True
224 Just (StringLiteral _ pkg_fs) -> pkg_fs == fsLit "this" ||
225 fsToUnitId pkg_fs == moduleUnitId this_mod))
226 (addErr (ptext (sLit "A module cannot import itself:") <+> ppr imp_mod_name))
227
228 -- Check for a missing import list (Opt_WarnMissingImportList also
229 -- checks for T(..) items but that is done in checkDodgyImport below)
230 case imp_details of
231 Just (False, _) -> return () -- Explicit import list
232 _ | implicit -> return () -- Do not bleat for implicit imports
233 | qual_only -> return ()
234 | otherwise -> whenWOptM Opt_WarnMissingImportList $
235 addWarn (missingImportListWarn imp_mod_name)
236
237 iface <- loadSrcInterface doc imp_mod_name want_boot (fmap sl_fs mb_pkg)
238
239 -- Compiler sanity check: if the import didn't say
240 -- {-# SOURCE #-} we should not get a hi-boot file
241 WARN( not want_boot && mi_boot iface, ppr imp_mod_name ) do
242
243 -- Issue a user warning for a redundant {- SOURCE -} import
244 -- NB that we arrange to read all the ordinary imports before
245 -- any of the {- SOURCE -} imports.
246 --
247 -- in --make and GHCi, the compilation manager checks for this,
248 -- and indeed we shouldn't do it here because the existence of
249 -- the non-boot module depends on the compilation order, which
250 -- is not deterministic. The hs-boot test can show this up.
251 dflags <- getDynFlags
252 warnIf (want_boot && not (mi_boot iface) && isOneShot (ghcMode dflags))
253 (warnRedundantSourceImport imp_mod_name)
254 when (mod_safe && not (safeImportsOn dflags)) $
255 addErr (ptext (sLit "safe import can't be used as Safe Haskell isn't on!")
256 $+$ ptext (sLit $ "please enable Safe Haskell through either "
257 ++ "Safe, Trustworthy or Unsafe"))
258
259 let
260 qual_mod_name = as_mod `orElse` imp_mod_name
261 imp_spec = ImpDeclSpec { is_mod = imp_mod_name, is_qual = qual_only,
262 is_dloc = loc, is_as = qual_mod_name }
263
264 -- filter the imports according to the import declaration
265 (new_imp_details, gres) <- filterImports iface imp_spec imp_details
266
267 -- for certain error messages, we’d like to know what could be imported
268 -- here, if everything were imported
269 potential_gres <- mkGlobalRdrEnv . snd <$> filterImports iface imp_spec Nothing
270
271 let gbl_env = mkGlobalRdrEnv gres
272
273 is_hiding | Just (True,_) <- imp_details = True
274 | otherwise = False
275
276 -- should the import be safe?
277 mod_safe' = mod_safe
278 || (not implicit && safeDirectImpsReq dflags)
279 || (implicit && safeImplicitImpsReq dflags)
280
281 let imv = ImportedModsVal
282 { imv_name = qual_mod_name
283 , imv_span = loc
284 , imv_is_safe = mod_safe'
285 , imv_is_hiding = is_hiding
286 , imv_all_exports = potential_gres
287 , imv_qualified = qual_only
288 }
289 let imports
290 = (calculateAvails dflags iface mod_safe' want_boot)
291 { imp_mods = unitModuleEnv (mi_module iface) [imv] }
292
293 -- Complain if we import a deprecated module
294 whenWOptM Opt_WarnWarningsDeprecations (
295 case (mi_warns iface) of
296 WarnAll txt -> addWarn $ moduleWarn imp_mod_name txt
297 _ -> return ()
298 )
299
300 let new_imp_decl = L loc (decl { ideclSafe = mod_safe'
301 , ideclHiding = new_imp_details })
302
303 return (new_imp_decl, gbl_env, imports, mi_hpc iface)
304
305 -- | Calculate the 'ImportAvails' induced by an import of a particular
306 -- interface, but without 'imp_mods'.
307 calculateAvails :: DynFlags
308 -> ModIface
309 -> IsSafeImport
310 -> IsBootInterface
311 -> ImportAvails
312 calculateAvails dflags iface mod_safe' want_boot =
313 let imp_mod = mi_module iface
314 orph_iface = mi_orphan iface
315 has_finsts = mi_finsts iface
316 deps = mi_deps iface
317 trust = getSafeMode $ mi_trust iface
318 trust_pkg = mi_trust_pkg iface
319
320 -- If the module exports anything defined in this module, just
321 -- ignore it. Reason: otherwise it looks as if there are two
322 -- local definition sites for the thing, and an error gets
323 -- reported. Easiest thing is just to filter them out up
324 -- front. This situation only arises if a module imports
325 -- itself, or another module that imported it. (Necessarily,
326 -- this invoves a loop.)
327 --
328 -- We do this *after* filterImports, so that if you say
329 -- module A where
330 -- import B( AType )
331 -- type AType = ...
332 --
333 -- module B( AType ) where
334 -- import {-# SOURCE #-} A( AType )
335 --
336 -- then you won't get a 'B does not export AType' message.
337
338
339 -- Compute new transitive dependencies
340
341 orphans | orph_iface = ASSERT( not (imp_mod `elem` dep_orphs deps) )
342 imp_mod : dep_orphs deps
343 | otherwise = dep_orphs deps
344
345 finsts | has_finsts = ASSERT( not (imp_mod `elem` dep_finsts deps) )
346 imp_mod : dep_finsts deps
347 | otherwise = dep_finsts deps
348
349 pkg = moduleUnitId (mi_module iface)
350
351 -- Does this import mean we now require our own pkg
352 -- to be trusted? See Note [Trust Own Package]
353 ptrust = trust == Sf_Trustworthy || trust_pkg
354
355 (dependent_mods, dependent_pkgs, pkg_trust_req)
356 | pkg == thisPackage dflags =
357 -- Imported module is from the home package
358 -- Take its dependent modules and add imp_mod itself
359 -- Take its dependent packages unchanged
360 --
361 -- NB: (dep_mods deps) might include a hi-boot file
362 -- for the module being compiled, CM. Do *not* filter
363 -- this out (as we used to), because when we've
364 -- finished dealing with the direct imports we want to
365 -- know if any of them depended on CM.hi-boot, in
366 -- which case we should do the hi-boot consistency
367 -- check. See LoadIface.loadHiBootInterface
368 ((moduleName imp_mod,want_boot):dep_mods deps,dep_pkgs deps,ptrust)
369
370 | otherwise =
371 -- Imported module is from another package
372 -- Dump the dependent modules
373 -- Add the package imp_mod comes from to the dependent packages
374 ASSERT2( not (pkg `elem` (map fst $ dep_pkgs deps))
375 , ppr pkg <+> ppr (dep_pkgs deps) )
376 ([], (pkg, False) : dep_pkgs deps, False)
377
378 in ImportAvails {
379 imp_mods = emptyModuleEnv, -- this gets filled in later
380 imp_orphs = orphans,
381 imp_finsts = finsts,
382 imp_dep_mods = mkModDeps dependent_mods,
383 imp_dep_pkgs = map fst $ dependent_pkgs,
384 -- Add in the imported modules trusted package
385 -- requirements. ONLY do this though if we import the
386 -- module as a safe import.
387 -- See Note [Tracking Trust Transitively]
388 -- and Note [Trust Transitive Property]
389 imp_trust_pkgs = if mod_safe'
390 then map fst $ filter snd dependent_pkgs
391 else [],
392 -- Do we require our own pkg to be trusted?
393 -- See Note [Trust Own Package]
394 imp_trust_own_pkg = pkg_trust_req
395 }
396
397
398 warnRedundantSourceImport :: ModuleName -> SDoc
399 warnRedundantSourceImport mod_name
400 = ptext (sLit "Unnecessary {-# SOURCE #-} in the import of module")
401 <+> quotes (ppr mod_name)
402
403 {-
404 ************************************************************************
405 * *
406 \subsection{importsFromLocalDecls}
407 * *
408 ************************************************************************
409
410 From the top-level declarations of this module produce
411 * the lexical environment
412 * the ImportAvails
413 created by its bindings.
414
415 Note [Top-level Names in Template Haskell decl quotes]
416 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
417 See also: Note [Interactively-bound Ids in GHCi] in HscTypes
418 Note [Looking up Exact RdrNames] in RnEnv
419
420 Consider a Template Haskell declaration quotation like this:
421 module M where
422 f x = h [d| f = 3 |]
423 When renaming the declarations inside [d| ...|], we treat the
424 top level binders specially in two ways
425
426 1. We give them an Internal Name, not (as usual) an External one.
427 This is done by RnEnv.newTopSrcBinder.
428
429 2. We make them *shadow* the outer bindings.
430 See Note [GlobalRdrEnv shadowing]
431
432 3. We find out whether we are inside a [d| ... |] by testing the TH
433 stage. This is a slight hack, because the stage field was really
434 meant for the type checker, and here we are not interested in the
435 fields of Brack, hence the error thunks in thRnBrack.
436 -}
437
438 extendGlobalRdrEnvRn :: [AvailInfo]
439 -> MiniFixityEnv
440 -> RnM (TcGblEnv, TcLclEnv)
441 -- Updates both the GlobalRdrEnv and the FixityEnv
442 -- We return a new TcLclEnv only because we might have to
443 -- delete some bindings from it;
444 -- see Note [Top-level Names in Template Haskell decl quotes]
445
446 extendGlobalRdrEnvRn avails new_fixities
447 = do { (gbl_env, lcl_env) <- getEnvs
448 ; stage <- getStage
449 ; isGHCi <- getIsGHCi
450 ; let rdr_env = tcg_rdr_env gbl_env
451 fix_env = tcg_fix_env gbl_env
452 th_bndrs = tcl_th_bndrs lcl_env
453 th_lvl = thLevel stage
454
455 -- Delete new_occs from global and local envs
456 -- If we are in a TemplateHaskell decl bracket,
457 -- we are going to shadow them
458 -- See Note [GlobalRdrEnv shadowing]
459 inBracket = isBrackStage stage
460
461 lcl_env_TH = lcl_env { tcl_rdr = delLocalRdrEnvList (tcl_rdr lcl_env) new_occs }
462 -- See Note [GlobalRdrEnv shadowing]
463
464 lcl_env2 | inBracket = lcl_env_TH
465 | otherwise = lcl_env
466
467 -- Deal with shadowing: see Note [GlobalRdrEnv shadowing]
468 want_shadowing = isGHCi || inBracket
469 rdr_env1 | want_shadowing = shadowNames rdr_env new_names
470 | otherwise = rdr_env
471
472 lcl_env3 = lcl_env2 { tcl_th_bndrs = extendNameEnvList th_bndrs
473 [ (n, (TopLevel, th_lvl))
474 | n <- new_names ] }
475
476 ; rdr_env2 <- foldlM add_gre rdr_env1 new_gres
477
478 ; let fix_env' = foldl extend_fix_env fix_env new_names
479 gbl_env' = gbl_env { tcg_rdr_env = rdr_env2, tcg_fix_env = fix_env' }
480
481 ; traceRn (text "extendGlobalRdrEnvRn 2" <+> (pprGlobalRdrEnv True rdr_env2))
482 ; return (gbl_env', lcl_env3) }
483 where
484 new_names = concatMap availNames avails
485 new_occs = map nameOccName new_names
486
487 -- If there is a fixity decl for the gre, add it to the fixity env
488 extend_fix_env fix_env name
489 | Just (L _ fi) <- lookupFsEnv new_fixities (occNameFS occ)
490 = extendNameEnv fix_env name (FixItem occ fi)
491 | otherwise
492 = fix_env
493 where
494 occ = nameOccName name
495
496 new_gres :: [GlobalRdrElt] -- New LocalDef GREs, derived from avails
497 new_gres = concatMap localGREsFromAvail avails
498
499 add_gre :: GlobalRdrEnv -> GlobalRdrElt -> RnM GlobalRdrEnv
500 -- Extend the GlobalRdrEnv with a LocalDef GRE
501 -- If there is already a LocalDef GRE with the same OccName,
502 -- report an error and discard the new GRE
503 -- This establishes INVARIANT 1 of GlobalRdrEnvs
504 add_gre env gre
505 | not (null dups) -- Same OccName defined twice
506 = do { addDupDeclErr (gre : dups); return env }
507
508 | otherwise
509 = return (extendGlobalRdrEnv env gre)
510 where
511 name = gre_name gre
512 occ = nameOccName name
513 dups = filter isLocalGRE (lookupGlobalRdrEnv env occ)
514
515
516 {- *********************************************************************
517 * *
518 getLocalDeclBindersd@ returns the names for an HsDecl
519 It's used for source code.
520
521 *** See "THE NAMING STORY" in HsDecls ****
522 * *
523 ********************************************************************* -}
524
525 getLocalNonValBinders :: MiniFixityEnv -> HsGroup RdrName
526 -> RnM ((TcGblEnv, TcLclEnv), NameSet)
527 -- Get all the top-level binders bound the group *except*
528 -- for value bindings, which are treated separately
529 -- Specifically we return AvailInfo for
530 -- * type decls (incl constructors and record selectors)
531 -- * class decls (including class ops)
532 -- * associated types
533 -- * foreign imports
534 -- * value signatures (in hs-boot files only)
535
536 getLocalNonValBinders fixity_env
537 (HsGroup { hs_valds = binds,
538 hs_tyclds = tycl_decls,
539 hs_instds = inst_decls,
540 hs_fords = foreign_decls })
541 = do { -- Process all type/class decls *except* family instances
542 ; overload_ok <- xoptM Opt_DuplicateRecordFields
543 ; (tc_avails, tc_fldss) <- fmap unzip $ mapM (new_tc overload_ok)
544 (tyClGroupConcat tycl_decls)
545 ; traceRn (text "getLocalNonValBinders 1" <+> ppr tc_avails)
546 ; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
547 ; setEnvs envs $ do {
548 -- Bring these things into scope first
549 -- See Note [Looking up family names in family instances]
550
551 -- Process all family instances
552 -- to bring new data constructors into scope
553 ; (nti_availss, nti_fldss) <- mapAndUnzipM (new_assoc overload_ok)
554 inst_decls
555
556 -- Finish off with value binders:
557 -- foreign decls and pattern synonyms for an ordinary module
558 -- type sigs in case of a hs-boot file only
559 ; is_boot <- tcIsHsBootOrSig
560 ; let val_bndrs | is_boot = hs_boot_sig_bndrs
561 | otherwise = for_hs_bndrs
562 ; val_avails <- mapM new_simple val_bndrs
563
564 ; let avails = concat nti_availss ++ val_avails
565 new_bndrs = availsToNameSet avails `unionNameSet`
566 availsToNameSet tc_avails
567 flds = concat nti_fldss ++ concat tc_fldss
568 ; traceRn (text "getLocalNonValBinders 2" <+> ppr avails)
569 ; (tcg_env, tcl_env) <- extendGlobalRdrEnvRn avails fixity_env
570
571 -- Extend tcg_field_env with new fields (this used to be the
572 -- work of extendRecordFieldEnv)
573 ; let field_env = extendNameEnvList (tcg_field_env tcg_env) flds
574 envs = (tcg_env { tcg_field_env = field_env }, tcl_env)
575
576 ; return (envs, new_bndrs) } }
577 where
578 ValBindsIn _val_binds val_sigs = binds
579
580 for_hs_bndrs :: [Located RdrName]
581 for_hs_bndrs = hsForeignDeclsBinders foreign_decls
582
583 -- In a hs-boot file, the value binders come from the
584 -- *signatures*, and there should be no foreign binders
585 hs_boot_sig_bndrs = [ L decl_loc (unLoc n)
586 | L decl_loc (TypeSig ns _ _) <- val_sigs, n <- ns]
587
588 -- the SrcSpan attached to the input should be the span of the
589 -- declaration, not just the name
590 new_simple :: Located RdrName -> RnM AvailInfo
591 new_simple rdr_name = do{ nm <- newTopSrcBinder rdr_name
592 ; return (avail nm) }
593
594 new_tc :: Bool -> LTyClDecl RdrName
595 -> RnM (AvailInfo, [(Name, [FieldLabel])])
596 new_tc overload_ok tc_decl -- NOT for type/data instances
597 = do { let (bndrs, flds) = hsLTyClDeclBinders tc_decl
598 ; names@(main_name : sub_names) <- mapM newTopSrcBinder bndrs
599 ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
600 ; let fld_env = case unLoc tc_decl of
601 DataDecl { tcdDataDefn = d } -> mk_fld_env d names flds'
602 _ -> []
603 ; return (AvailTC main_name names flds', fld_env) }
604
605
606 -- Calculate the mapping from constructor names to fields, which
607 -- will go in tcg_field_env. It's convenient to do this here where
608 -- we are working with a single datatype definition.
609 mk_fld_env :: HsDataDefn RdrName -> [Name] -> [FieldLabel] -> [(Name, [FieldLabel])]
610 mk_fld_env d names flds = concatMap find_con_flds (dd_cons d)
611 where
612 find_con_flds (L _ (ConDecl { con_names = rdrs
613 , con_details = RecCon cdflds }))
614 = map (\ (L _ rdr) -> ( find_con_name rdr
615 , concatMap find_con_decl_flds (unLoc cdflds)))
616 rdrs
617 find_con_flds _ = []
618
619 find_con_name rdr
620 = expectJust "getLocalNonValBinders/find_con_name" $
621 find (\ n -> nameOccName n == rdrNameOcc rdr) names
622 find_con_decl_flds (L _ x)
623 = map find_con_decl_fld (cd_fld_names x)
624 find_con_decl_fld (L _ (FieldOcc rdr _))
625 = expectJust "getLocalNonValBinders/find_con_decl_fld" $
626 find (\ fl -> flLabel fl == lbl) flds
627 where lbl = occNameFS (rdrNameOcc rdr)
628
629 new_assoc :: Bool -> LInstDecl RdrName
630 -> RnM ([AvailInfo], [(Name, [FieldLabel])])
631 new_assoc _ (L _ (TyFamInstD {})) = return ([], [])
632 -- type instances don't bind new names
633
634 new_assoc overload_ok (L _ (DataFamInstD d))
635 = do { (avail, flds) <- new_di overload_ok Nothing d
636 ; return ([avail], flds) }
637 new_assoc overload_ok (L _ (ClsInstD (ClsInstDecl { cid_poly_ty = inst_ty
638 , cid_datafam_insts = adts })))
639 | Just (_, _, L loc cls_rdr, _) <-
640 splitLHsInstDeclTy_maybe (flattenTopLevelLHsForAllTy inst_ty)
641 = do { cls_nm <- setSrcSpan loc $ lookupGlobalOccRn cls_rdr
642 ; (avails, fldss)
643 <- mapAndUnzipM (new_loc_di overload_ok (Just cls_nm)) adts
644 ; return (avails, concat fldss) }
645 | otherwise
646 = return ([], []) -- Do not crash on ill-formed instances
647 -- Eg instance !Show Int Trac #3811c
648
649 new_di :: Bool -> Maybe Name -> DataFamInstDecl RdrName
650 -> RnM (AvailInfo, [(Name, [FieldLabel])])
651 new_di overload_ok mb_cls ti_decl
652 = do { main_name <- lookupFamInstName mb_cls (dfid_tycon ti_decl)
653 ; let (bndrs, flds) = hsDataFamInstBinders ti_decl
654 ; sub_names <- mapM newTopSrcBinder bndrs
655 ; flds' <- mapM (newRecordSelector overload_ok sub_names) flds
656 ; let avail = AvailTC (unLoc main_name) sub_names flds'
657 -- main_name is not bound here!
658 fld_env = mk_fld_env (dfid_defn ti_decl) sub_names flds'
659 ; return (avail, fld_env) }
660
661 new_loc_di :: Bool -> Maybe Name -> LDataFamInstDecl RdrName
662 -> RnM (AvailInfo, [(Name, [FieldLabel])])
663 new_loc_di overload_ok mb_cls (L _ d) = new_di overload_ok mb_cls d
664
665 newRecordSelector :: Bool -> [Name] -> LFieldOcc RdrName -> RnM FieldLabel
666 newRecordSelector _ [] _ = error "newRecordSelector: datatype has no constructors!"
667 newRecordSelector overload_ok (dc:_) (L loc (FieldOcc fld _)) =
668 do { sel_name <- newTopSrcBinder $ L loc $ mkRdrUnqual sel_occ
669 ; return $ fl { flSelector = sel_name } }
670 where
671 lbl = occNameFS $ rdrNameOcc fld
672 fl = mkFieldLabelOccs lbl (nameOccName dc) overload_ok
673 sel_occ = flSelector fl
674
675 {-
676 Note [Looking up family names in family instances]
677 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
678 Consider
679
680 module M where
681 type family T a :: *
682 type instance M.T Int = Bool
683
684 We might think that we can simply use 'lookupOccRn' when processing the type
685 instance to look up 'M.T'. Alas, we can't! The type family declaration is in
686 the *same* HsGroup as the type instance declaration. Hence, as we are
687 currently collecting the binders declared in that HsGroup, these binders will
688 not have been added to the global environment yet.
689
690 Solution is simple: process the type family declarations first, extend
691 the environment, and then process the type instances.
692
693
694 ************************************************************************
695 * *
696 \subsection{Filtering imports}
697 * *
698 ************************************************************************
699
700 @filterImports@ takes the @ExportEnv@ telling what the imported module makes
701 available, and filters it through the import spec (if any).
702
703 Note [Dealing with imports]
704 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
705 For import M( ies ), we take the mi_exports of M, and make
706 imp_occ_env :: OccEnv (Name, AvailInfo, Maybe Name)
707 One entry for each Name that M exports; the AvailInfo describes just
708 that Name.
709
710 The situation is made more complicated by associated types. E.g.
711 module M where
712 class C a where { data T a }
713 instance C Int where { data T Int = T1 | T2 }
714 instance C Bool where { data T Int = T3 }
715 Then M's export_avails are (recall the AvailTC invariant from Avails.hs)
716 C(C,T), T(T,T1,T2,T3)
717 Notice that T appears *twice*, once as a child and once as a parent.
718 From this we construct the imp_occ_env
719 C -> (C, C(C,T), Nothing)
720 T -> (T, T(T,T1,T2,T3), Just C)
721 T1 -> (T1, T(T1,T2,T3), Nothing) -- similarly T2,T3
722
723 If we say
724 import M( T(T1,T2) )
725 then we get *two* Avails: C(T), T(T1,T2)
726
727 Note that the imp_occ_env will have entries for data constructors too,
728 although we never look up data constructors.
729 -}
730
731 filterImports
732 :: ModIface
733 -> ImpDeclSpec -- The span for the entire import decl
734 -> Maybe (Bool, Located [LIE RdrName]) -- Import spec; True => hiding
735 -> RnM (Maybe (Bool, Located [LIE Name]), -- Import spec w/ Names
736 [GlobalRdrElt]) -- Same again, but in GRE form
737 filterImports iface decl_spec Nothing
738 = return (Nothing, gresFromAvails (Just imp_spec) (mi_exports iface))
739 where
740 imp_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
741
742
743 filterImports iface decl_spec (Just (want_hiding, L l import_items))
744 = do -- check for errors, convert RdrNames to Names
745 items1 <- mapM lookup_lie import_items
746
747 let items2 :: [(LIE Name, AvailInfo)]
748 items2 = concat items1
749 -- NB the AvailInfo may have duplicates, and several items
750 -- for the same parent; e.g N(x) and N(y)
751
752 names = availsToNameSet (map snd items2)
753 keep n = not (n `elemNameSet` names)
754 pruned_avails = filterAvails keep all_avails
755 hiding_spec = ImpSpec { is_decl = decl_spec, is_item = ImpAll }
756
757 gres | want_hiding = gresFromAvails (Just hiding_spec) pruned_avails
758 | otherwise = concatMap (gresFromIE decl_spec) items2
759
760 return (Just (want_hiding, L l (map fst items2)), gres)
761 where
762 all_avails = mi_exports iface
763
764 -- See Note [Dealing with imports]
765 imp_occ_env :: OccEnv (Name, -- the name
766 AvailInfo, -- the export item providing the name
767 Maybe Name) -- the parent of associated types
768 imp_occ_env = mkOccEnv_C combine [ (nameOccName n, (n, a, Nothing))
769 | a <- all_avails, n <- availNames a]
770 where
771 -- See example in Note [Dealing with imports]
772 -- 'combine' is only called for associated types which appear twice
773 -- in the all_avails. In the example, we combine
774 -- T(T,T1,T2,T3) and C(C,T) to give (T, T(T,T1,T2,T3), Just C)
775 combine (name1, a1@(AvailTC p1 _ []), mp1)
776 (name2, a2@(AvailTC p2 _ []), mp2)
777 = ASSERT( name1 == name2 && isNothing mp1 && isNothing mp2 )
778 if p1 == name1 then (name1, a1, Just p2)
779 else (name1, a2, Just p1)
780 combine x y = pprPanic "filterImports/combine" (ppr x $$ ppr y)
781
782 lookup_name :: RdrName -> IELookupM (Name, AvailInfo, Maybe Name)
783 lookup_name rdr | isQual rdr = failLookupWith (QualImportError rdr)
784 | Just succ <- mb_success = return succ
785 | otherwise = failLookupWith BadImport
786 where
787 mb_success = lookupOccEnv imp_occ_env (rdrNameOcc rdr)
788
789 lookup_lie :: LIE RdrName -> TcRn [(LIE Name, AvailInfo)]
790 lookup_lie (L loc ieRdr)
791 = do (stuff, warns) <- setSrcSpan loc $
792 liftM (fromMaybe ([],[])) $
793 run_lookup (lookup_ie ieRdr)
794 mapM_ emit_warning warns
795 return [ (L loc ie, avail) | (ie,avail) <- stuff ]
796 where
797 -- Warn when importing T(..) if T was exported abstractly
798 emit_warning (DodgyImport n) = whenWOptM Opt_WarnDodgyImports $
799 addWarn (dodgyImportWarn n)
800 emit_warning MissingImportList = whenWOptM Opt_WarnMissingImportList $
801 addWarn (missingImportListItem ieRdr)
802 emit_warning BadImportW = whenWOptM Opt_WarnDodgyImports $
803 addWarn (lookup_err_msg BadImport)
804
805 run_lookup :: IELookupM a -> TcRn (Maybe a)
806 run_lookup m = case m of
807 Failed err -> addErr (lookup_err_msg err) >> return Nothing
808 Succeeded a -> return (Just a)
809
810 lookup_err_msg err = case err of
811 BadImport -> badImportItemErr iface decl_spec ieRdr all_avails
812 IllegalImport -> illegalImportItemErr
813 QualImportError rdr -> qualImportItemErr rdr
814
815 -- For each import item, we convert its RdrNames to Names,
816 -- and at the same time construct an AvailInfo corresponding
817 -- to what is actually imported by this item.
818 -- Returns Nothing on error.
819 -- We return a list here, because in the case of an import
820 -- item like C, if we are hiding, then C refers to *both* a
821 -- type/class and a data constructor. Moreover, when we import
822 -- data constructors of an associated family, we need separate
823 -- AvailInfos for the data constructors and the family (as they have
824 -- different parents). See Note [Dealing with imports]
825 lookup_ie :: IE RdrName -> IELookupM ([(IE Name, AvailInfo)], [IELookupWarning])
826 lookup_ie ie = handle_bad_import $ do
827 case ie of
828 IEVar (L l n) -> do
829 (name, avail, _) <- lookup_name n
830 return ([(IEVar (L l name), trimAvail avail name)], [])
831
832 IEThingAll (L l tc) -> do
833 (name, avail, mb_parent) <- lookup_name tc
834 let warns = case avail of
835 Avail {} -- e.g. f(..)
836 -> [DodgyImport tc]
837
838 AvailTC _ subs fs
839 | null (drop 1 subs) && null fs -- e.g. T(..) where T is a synonym
840 -> [DodgyImport tc]
841
842 | not (is_qual decl_spec) -- e.g. import M( T(..) )
843 -> [MissingImportList]
844
845 | otherwise
846 -> []
847
848 renamed_ie = IEThingAll (L l name)
849 sub_avails = case avail of
850 Avail {} -> []
851 AvailTC name2 subs fs -> [(renamed_ie, AvailTC name2 (subs \\ [name]) fs)]
852 case mb_parent of
853 Nothing -> return ([(renamed_ie, avail)], warns)
854 -- non-associated ty/cls
855 Just parent -> return ((renamed_ie, AvailTC parent [name] []) : sub_avails, warns)
856 -- associated type
857
858 IEThingAbs (L l tc)
859 | want_hiding -- hiding ( C )
860 -- Here the 'C' can be a data constructor
861 -- *or* a type/class, or even both
862 -> let tc_name = lookup_name tc
863 dc_name = lookup_name (setRdrNameSpace tc srcDataName)
864 in
865 case catIELookupM [ tc_name, dc_name ] of
866 [] -> failLookupWith BadImport
867 names -> return ([mkIEThingAbs l name | name <- names], [])
868 | otherwise
869 -> do nameAvail <- lookup_name tc
870 return ([mkIEThingAbs l nameAvail], [])
871
872 IEThingWith (L l rdr_tc) wc rdr_ns rdr_fs ->
873 ASSERT2(null rdr_fs, ppr rdr_fs) do
874 (name, AvailTC _ ns subflds, mb_parent) <- lookup_name rdr_tc
875
876 -- Look up the children in the sub-names of the parent
877 let subnames = case ns of -- The tc is first in ns,
878 [] -> [] -- if it is there at all
879 -- See the AvailTC Invariant in Avail.hs
880 (n1:ns1) | n1 == name -> ns1
881 | otherwise -> ns
882 case lookupChildren (map Left subnames ++ map Right subflds) rdr_ns of
883 Nothing -> failLookupWith BadImport
884 Just (childnames, childflds) ->
885 case mb_parent of
886 -- non-associated ty/cls
887 Nothing
888 -> return ([(IEThingWith (L l name) wc childnames childflds,
889 AvailTC name (name:map unLoc childnames) (map unLoc childflds))],
890 [])
891 -- associated ty
892 Just parent
893 -> return ([(IEThingWith (L l name) wc childnames childflds,
894 AvailTC name (map unLoc childnames) (map unLoc childflds)),
895 (IEThingWith (L l name) wc childnames childflds,
896 AvailTC parent [name] [])],
897 [])
898
899 _other -> failLookupWith IllegalImport
900 -- could be IEModuleContents, IEGroup, IEDoc, IEDocNamed
901 -- all errors.
902
903 where
904 mkIEThingAbs l (n, av, Nothing ) = (IEThingAbs (L l n),
905 trimAvail av n)
906 mkIEThingAbs l (n, _, Just parent) = (IEThingAbs (L l n),
907 AvailTC parent [n] [])
908
909 handle_bad_import m = catchIELookup m $ \err -> case err of
910 BadImport | want_hiding -> return ([], [BadImportW])
911 _ -> failLookupWith err
912
913 type IELookupM = MaybeErr IELookupError
914
915 data IELookupWarning
916 = BadImportW
917 | MissingImportList
918 | DodgyImport RdrName
919 -- NB. use the RdrName for reporting a "dodgy" import
920
921 data IELookupError
922 = QualImportError RdrName
923 | BadImport
924 | IllegalImport
925
926 failLookupWith :: IELookupError -> IELookupM a
927 failLookupWith err = Failed err
928
929 catchIELookup :: IELookupM a -> (IELookupError -> IELookupM a) -> IELookupM a
930 catchIELookup m h = case m of
931 Succeeded r -> return r
932 Failed err -> h err
933
934 catIELookupM :: [IELookupM a] -> [a]
935 catIELookupM ms = [ a | Succeeded a <- ms ]
936
937 {-
938 ************************************************************************
939 * *
940 \subsection{Import/Export Utils}
941 * *
942 ************************************************************************
943 -}
944
945 plusAvail :: AvailInfo -> AvailInfo -> AvailInfo
946 plusAvail a1 a2
947 | debugIsOn && availName a1 /= availName a2
948 = pprPanic "RnEnv.plusAvail names differ" (hsep [ppr a1,ppr a2])
949 plusAvail a1@(Avail {}) (Avail {}) = a1
950 plusAvail (AvailTC _ [] []) a2@(AvailTC {}) = a2
951 plusAvail a1@(AvailTC {}) (AvailTC _ [] []) = a1
952 plusAvail (AvailTC n1 (s1:ss1) fs1) (AvailTC n2 (s2:ss2) fs2)
953 = case (n1==s1, n2==s2) of -- Maintain invariant the parent is first
954 (True,True) -> AvailTC n1 (s1 : (ss1 `unionLists` ss2))
955 (fs1 `unionLists` fs2)
956 (True,False) -> AvailTC n1 (s1 : (ss1 `unionLists` (s2:ss2)))
957 (fs1 `unionLists` fs2)
958 (False,True) -> AvailTC n1 (s2 : ((s1:ss1) `unionLists` ss2))
959 (fs1 `unionLists` fs2)
960 (False,False) -> AvailTC n1 ((s1:ss1) `unionLists` (s2:ss2))
961 (fs1 `unionLists` fs2)
962 plusAvail (AvailTC n1 ss1 fs1) (AvailTC _ [] fs2)
963 = AvailTC n1 ss1 (fs1 `unionLists` fs2)
964 plusAvail (AvailTC n1 [] fs1) (AvailTC _ ss2 fs2)
965 = AvailTC n1 ss2 (fs1 `unionLists` fs2)
966 plusAvail a1 a2 = pprPanic "RnEnv.plusAvail" (hsep [ppr a1,ppr a2])
967
968 -- | trims an 'AvailInfo' to keep only a single name
969 trimAvail :: AvailInfo -> Name -> AvailInfo
970 trimAvail (Avail b n) _ = Avail b n
971 trimAvail (AvailTC n ns fs) m = case find ((== m) . flSelector) fs of
972 Just x -> AvailTC n [] [x]
973 Nothing -> ASSERT( m `elem` ns ) AvailTC n [m] []
974
975 -- | filters 'AvailInfo's by the given predicate
976 filterAvails :: (Name -> Bool) -> [AvailInfo] -> [AvailInfo]
977 filterAvails keep avails = foldr (filterAvail keep) [] avails
978
979 -- | filters an 'AvailInfo' by the given predicate
980 filterAvail :: (Name -> Bool) -> AvailInfo -> [AvailInfo] -> [AvailInfo]
981 filterAvail keep ie rest =
982 case ie of
983 Avail _ n | keep n -> ie : rest
984 | otherwise -> rest
985 AvailTC tc ns fs ->
986 let ns' = filter keep ns
987 fs' = filter (keep . flSelector) fs in
988 if null ns' && null fs' then rest else AvailTC tc ns' fs' : rest
989
990 -- | Given an import\/export spec, construct the appropriate 'GlobalRdrElt's.
991 gresFromIE :: ImpDeclSpec -> (LIE Name, AvailInfo) -> [GlobalRdrElt]
992 gresFromIE decl_spec (L loc ie, avail)
993 = gresFromAvail prov_fn avail
994 where
995 is_explicit = case ie of
996 IEThingAll (L _ name) -> \n -> n == name
997 _ -> \_ -> True
998 prov_fn name
999 = Just (ImpSpec { is_decl = decl_spec, is_item = item_spec })
1000 where
1001 item_spec = ImpSome { is_explicit = is_explicit name, is_iloc = loc }
1002
1003
1004 {-
1005 Note [Children for duplicate record fields]
1006 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1007 Consider the module
1008
1009 {-# LANGUAGE DuplicateRecordFields #-}
1010 module M (F(foo, MkFInt, MkFBool)) where
1011 data family F a
1012 data instance F Int = MkFInt { foo :: Int }
1013 data instance F Bool = MkFBool { foo :: Bool }
1014
1015 The `foo` in the export list refers to *both* selectors! For this
1016 reason, lookupChildren builds an environment that maps the FastString
1017 to a list of items, rather than a single item.
1018 -}
1019
1020 mkChildEnv :: [GlobalRdrElt] -> NameEnv [GlobalRdrElt]
1021 mkChildEnv gres = foldr add emptyNameEnv gres
1022 where
1023 add gre env = case gre_par gre of
1024 FldParent p _ -> extendNameEnv_Acc (:) singleton env p gre
1025 ParentIs p -> extendNameEnv_Acc (:) singleton env p gre
1026 NoParent -> env
1027 PatternSynonym -> env
1028
1029 findPatSyns :: [GlobalRdrElt] -> [GlobalRdrElt]
1030 findPatSyns gres = foldr add [] gres
1031 where
1032 add g@(GRE { gre_par = PatternSynonym }) ps =
1033 g:ps
1034 add _ ps = ps
1035
1036 findChildren :: NameEnv [a] -> Name -> [a]
1037 findChildren env n = lookupNameEnv env n `orElse` []
1038
1039 lookupChildren :: [Either Name FieldLabel] -> [Located RdrName]
1040 -> Maybe ([Located Name], [Located FieldLabel])
1041 -- (lookupChildren all_kids rdr_items) maps each rdr_item to its
1042 -- corresponding Name all_kids, if the former exists
1043 -- The matching is done by FastString, not OccName, so that
1044 -- Cls( meth, AssocTy )
1045 -- will correctly find AssocTy among the all_kids of Cls, even though
1046 -- the RdrName for AssocTy may have a (bogus) DataName namespace
1047 -- (Really the rdr_items should be FastStrings in the first place.)
1048 lookupChildren all_kids rdr_items
1049 = do xs <- mapM doOne rdr_items
1050 return (fmap concat (partitionEithers xs))
1051 where
1052 doOne (L l r) = case (lookupFsEnv kid_env . occNameFS . rdrNameOcc) r of
1053 Just [Left n] -> Just (Left (L l n))
1054 Just rs | all isRight rs -> Just (Right (map (L l) (rights rs)))
1055 _ -> Nothing
1056
1057 -- See Note [Children for duplicate record fields]
1058 kid_env = extendFsEnvList_C (++) emptyFsEnv
1059 [(either (occNameFS . nameOccName) flLabel x, [x]) | x <- all_kids]
1060
1061
1062 classifyGREs :: [GlobalRdrElt] -> ([Name], [FieldLabel])
1063 classifyGREs = partitionEithers . map classifyGRE
1064
1065 classifyGRE :: GlobalRdrElt -> Either Name FieldLabel
1066 classifyGRE gre = case gre_par gre of
1067 FldParent _ Nothing -> Right (FieldLabel (occNameFS (nameOccName n)) False n)
1068 FldParent _ (Just lbl) -> Right (FieldLabel lbl True n)
1069 _ -> Left n
1070 where
1071 n = gre_name gre
1072
1073 -- | Combines 'AvailInfo's from the same family
1074 -- 'avails' may have several items with the same availName
1075 -- E.g import Ix( Ix(..), index )
1076 -- will give Ix(Ix,index,range) and Ix(index)
1077 -- We want to combine these; addAvail does that
1078 nubAvails :: [AvailInfo] -> [AvailInfo]
1079 nubAvails avails = nameEnvElts (foldl add emptyNameEnv avails)
1080 where
1081 add env avail = extendNameEnv_C plusAvail env (availName avail) avail
1082
1083 {-
1084 ************************************************************************
1085 * *
1086 \subsection{Export list processing}
1087 * *
1088 ************************************************************************
1089
1090 Processing the export list.
1091
1092 You might think that we should record things that appear in the export
1093 list as ``occurrences'' (using @addOccurrenceName@), but you'd be
1094 wrong. We do check (here) that they are in scope, but there is no
1095 need to slurp in their actual declaration (which is what
1096 @addOccurrenceName@ forces).
1097
1098 Indeed, doing so would big trouble when compiling @PrelBase@, because
1099 it re-exports @GHC@, which includes @takeMVar#@, whose type includes
1100 @ConcBase.StateAndSynchVar#@, and so on...
1101
1102 Note [Exports of data families]
1103 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1104 Suppose you see (Trac #5306)
1105 module M where
1106 import X( F )
1107 data instance F Int = FInt
1108 What does M export? AvailTC F [FInt]
1109 or AvailTC F [F,FInt]?
1110 The former is strictly right because F isn't defined in this module.
1111 But then you can never do an explicit import of M, thus
1112 import M( F( FInt ) )
1113 because F isn't exported by M. Nor can you import FInt alone from here
1114 import M( FInt )
1115 because we don't have syntax to support that. (It looks like an import of
1116 the type FInt.)
1117
1118 At one point I implemented a compromise:
1119 * When constructing exports with no export list, or with module M(
1120 module M ), we add the parent to the exports as well.
1121 * But not when you see module M( f ), even if f is a
1122 class method with a parent.
1123 * Nor when you see module M( module N ), with N /= M.
1124
1125 But the compromise seemed too much of a hack, so we backed it out.
1126 You just have to use an explicit export list:
1127 module M( F(..) ) where ...
1128 -}
1129
1130 type ExportAccum -- The type of the accumulating parameter of
1131 -- the main worker function in rnExports
1132 = ([LIE Name], -- Export items with Names
1133 ExportOccMap, -- Tracks exported occurrence names
1134 [AvailInfo]) -- The accumulated exported stuff
1135 -- Not nub'd!
1136
1137 emptyExportAccum :: ExportAccum
1138 emptyExportAccum = ([], emptyOccEnv, [])
1139
1140 type ExportOccMap = OccEnv (Name, IE RdrName)
1141 -- Tracks what a particular exported OccName
1142 -- in an export list refers to, and which item
1143 -- it came from. It's illegal to export two distinct things
1144 -- that have the same occurrence name
1145
1146 rnExports :: Bool -- False => no 'module M(..) where' header at all
1147 -> Maybe (Located [LIE RdrName]) -- Nothing => no explicit export list
1148 -> TcGblEnv
1149 -> RnM (Maybe [LIE Name], TcGblEnv)
1150
1151 -- Complains if two distinct exports have same OccName
1152 -- Warns about identical exports.
1153 -- Complains about exports items not in scope
1154
1155 rnExports explicit_mod exports
1156 tcg_env@(TcGblEnv { tcg_mod = this_mod,
1157 tcg_rdr_env = rdr_env,
1158 tcg_imports = imports })
1159 = unsetWOptM Opt_WarnWarningsDeprecations $
1160 -- Do not report deprecations arising from the export
1161 -- list, to avoid bleating about re-exporting a deprecated
1162 -- thing (especially via 'module Foo' export item)
1163 do {
1164 -- If the module header is omitted altogether, then behave
1165 -- as if the user had written "module Main(main) where..."
1166 -- EXCEPT in interactive mode, when we behave as if he had
1167 -- written "module Main where ..."
1168 -- Reason: don't want to complain about 'main' not in scope
1169 -- in interactive mode
1170 ; dflags <- getDynFlags
1171 ; let real_exports
1172 | explicit_mod = exports
1173 | ghcLink dflags == LinkInMemory = Nothing
1174 | otherwise
1175 = Just (noLoc [noLoc (IEVar (noLoc main_RDR_Unqual))])
1176 -- ToDo: the 'noLoc' here is unhelpful if 'main'
1177 -- turns out to be out of scope
1178
1179 ; (rn_exports, avails) <- exports_from_avail real_exports rdr_env imports this_mod
1180 ; traceRn (ppr avails)
1181 ; let final_avails = nubAvails avails -- Combine families
1182 final_ns = availsToNameSetWithSelectors final_avails
1183
1184 ; traceRn (text "rnExports: Exports:" <+> ppr final_avails)
1185
1186 ; let new_tcg_env =
1187 (tcg_env { tcg_exports = final_avails,
1188 tcg_rn_exports = case tcg_rn_exports tcg_env of
1189 Nothing -> Nothing
1190 Just _ -> rn_exports,
1191 tcg_dus = tcg_dus tcg_env `plusDU`
1192 usesOnly final_ns })
1193 ; return (rn_exports, new_tcg_env) }
1194
1195 exports_from_avail :: Maybe (Located [LIE RdrName])
1196 -- Nothing => no explicit export list
1197 -> GlobalRdrEnv
1198 -> ImportAvails
1199 -> Module
1200 -> RnM (Maybe [LIE Name], [AvailInfo])
1201
1202 exports_from_avail Nothing rdr_env _imports _this_mod
1203 = -- The same as (module M) where M is the current module name,
1204 -- so that's how we handle it.
1205 let
1206 avails = [ availFromGRE gre
1207 | gre <- globalRdrEnvElts rdr_env
1208 , isLocalGRE gre ]
1209 in
1210 return (Nothing, avails)
1211
1212 exports_from_avail (Just (L _ rdr_items)) rdr_env imports this_mod
1213 = do (ie_names, _, exports) <- foldlM do_litem emptyExportAccum rdr_items
1214 return (Just ie_names, exports)
1215 where
1216 do_litem :: ExportAccum -> LIE RdrName -> RnM ExportAccum
1217 do_litem acc lie = setSrcSpan (getLoc lie) (exports_from_item acc lie)
1218
1219 -- Maps a parent to its in-scope children
1220 kids_env :: NameEnv [GlobalRdrElt]
1221 kids_env = mkChildEnv (globalRdrEnvElts rdr_env)
1222
1223 pat_syns :: [GlobalRdrElt]
1224 pat_syns = findPatSyns (globalRdrEnvElts rdr_env)
1225
1226 imported_modules = [ imv_name imv
1227 | xs <- moduleEnvElts $ imp_mods imports, imv <- xs ]
1228
1229 exports_from_item :: ExportAccum -> LIE RdrName -> RnM ExportAccum
1230 exports_from_item acc@(ie_names, occs, exports)
1231 (L loc (IEModuleContents (L lm mod)))
1232 | let earlier_mods = [ mod
1233 | (L _ (IEModuleContents (L _ mod))) <- ie_names ]
1234 , mod `elem` earlier_mods -- Duplicate export of M
1235 = do { warn_dup_exports <- woptM Opt_WarnDuplicateExports ;
1236 warnIf warn_dup_exports (dupModuleExport mod) ;
1237 return acc }
1238
1239 | otherwise
1240 = do { warnDodgyExports <- woptM Opt_WarnDodgyExports
1241 ; let { exportValid = (mod `elem` imported_modules)
1242 || (moduleName this_mod == mod)
1243 ; gre_prs = pickGREsModExp mod (globalRdrEnvElts rdr_env)
1244 ; new_exports = map (availFromGRE . fst) gre_prs
1245 ; names = map (gre_name . fst) gre_prs
1246 ; all_gres = foldr (\(gre1,gre2) gres -> gre1 : gre2 : gres) [] gre_prs
1247 }
1248
1249 ; checkErr exportValid (moduleNotImported mod)
1250 ; warnIf (warnDodgyExports && exportValid && null gre_prs)
1251 (nullModuleExport mod)
1252
1253 ; traceRn (text "efa" <+> (ppr mod $$ ppr all_gres))
1254 ; addUsedGREs all_gres
1255
1256 ; occs' <- check_occs (IEModuleContents (noLoc mod)) occs names
1257 -- This check_occs not only finds conflicts
1258 -- between this item and others, but also
1259 -- internally within this item. That is, if
1260 -- 'M.x' is in scope in several ways, we'll have
1261 -- several members of mod_avails with the same
1262 -- OccName.
1263 ; traceRn (vcat [ text "export mod" <+> ppr mod
1264 , ppr new_exports ])
1265 ; return (L loc (IEModuleContents (L lm mod)) : ie_names,
1266 occs', new_exports ++ exports) }
1267
1268 exports_from_item acc@(lie_names, occs, exports) (L loc ie)
1269 | isDoc ie
1270 = do new_ie <- lookup_doc_ie ie
1271 return (L loc new_ie : lie_names, occs, exports)
1272
1273 | otherwise
1274 = do (new_ie, avail) <- lookup_ie ie
1275 if isUnboundName (ieName new_ie)
1276 then return acc -- Avoid error cascade
1277 else do
1278
1279 occs' <- check_occs ie occs (availNames avail)
1280
1281 return (L loc new_ie : lie_names, occs', avail : exports)
1282
1283 -------------
1284 lookup_ie :: IE RdrName -> RnM (IE Name, AvailInfo)
1285 lookup_ie (IEVar (L l rdr))
1286 = do (name, avail) <- lookupGreAvailRn rdr
1287 return (IEVar (L l name), avail)
1288
1289 lookup_ie (IEThingAbs (L l rdr))
1290 = do (name, avail) <- lookupGreAvailRn rdr
1291 return (IEThingAbs (L l name), avail)
1292
1293 lookup_ie ie@(IEThingAll n)
1294 = do
1295 (n, avail, flds) <- lookup_ie_all ie n
1296 let name = unLoc n
1297 return (IEThingAll n, AvailTC name (name:avail) flds)
1298
1299
1300 lookup_ie ie@(IEThingWith l wc sub_rdrs _)
1301 = do
1302 (lname, subs, avails, flds) <- lookup_ie_with ie l sub_rdrs
1303 (_, all_avail, all_flds) <-
1304 case wc of
1305 NoIEWildcard -> return (lname, [], [])
1306 IEWildcard _ -> lookup_ie_all ie l
1307 let name = unLoc lname
1308 return (IEThingWith lname wc subs [],
1309 AvailTC name (name : avails ++ all_avail)
1310 (flds ++ all_flds))
1311
1312
1313
1314
1315 lookup_ie _ = panic "lookup_ie" -- Other cases covered earlier
1316
1317 lookup_ie_with :: IE RdrName -> Located RdrName -> [Located RdrName]
1318 -> RnM (Located Name, [Located Name], [Name], [FieldLabel])
1319 lookup_ie_with ie (L l rdr) sub_rdrs
1320 = do name <- lookupGlobalOccRn rdr
1321 let gres = findChildren kids_env name
1322 mchildren =
1323 lookupChildren (map classifyGRE (gres ++ pat_syns)) sub_rdrs
1324 addUsedKids rdr gres
1325 if isUnboundName name
1326 then return (L l name, [], [name], [])
1327 else
1328 case mchildren of
1329 Nothing -> do
1330 addErr (exportItemErr ie)
1331 return (L l name, [], [name], [])
1332 Just (non_flds, flds) -> do
1333 addUsedKids rdr gres
1334 return (L l name, non_flds
1335 , map unLoc non_flds
1336 , map unLoc flds)
1337 lookup_ie_all :: IE RdrName -> Located RdrName
1338 -> RnM (Located Name, [Name], [FieldLabel])
1339 lookup_ie_all ie (L l rdr) =
1340 do name <- lookupGlobalOccRn rdr
1341 let gres = findChildren kids_env name
1342 (non_flds, flds) = classifyGREs gres
1343 addUsedKids rdr gres
1344 warnDodgyExports <- woptM Opt_WarnDodgyExports
1345 when (null gres) $
1346 if isTyConName name
1347 then when warnDodgyExports $ addWarn (dodgyExportWarn name)
1348 else -- This occurs when you export T(..), but
1349 -- only import T abstractly, or T is a synonym.
1350 addErr (exportItemErr ie)
1351 return (L l name, non_flds, flds)
1352
1353 -------------
1354 lookup_doc_ie :: IE RdrName -> RnM (IE Name)
1355 lookup_doc_ie (IEGroup lev doc) = do rn_doc <- rnHsDoc doc
1356 return (IEGroup lev rn_doc)
1357 lookup_doc_ie (IEDoc doc) = do rn_doc <- rnHsDoc doc
1358 return (IEDoc rn_doc)
1359 lookup_doc_ie (IEDocNamed str) = return (IEDocNamed str)
1360 lookup_doc_ie _ = panic "lookup_doc_ie" -- Other cases covered earlier
1361
1362 -- In an export item M.T(A,B,C), we want to treat the uses of
1363 -- A,B,C as if they were M.A, M.B, M.C
1364 -- Happily pickGREs does just the right thing
1365 addUsedKids :: RdrName -> [GlobalRdrElt] -> RnM ()
1366 addUsedKids parent_rdr kid_gres = addUsedGREs (pickGREs parent_rdr kid_gres)
1367
1368 isDoc :: IE RdrName -> Bool
1369 isDoc (IEDoc _) = True
1370 isDoc (IEDocNamed _) = True
1371 isDoc (IEGroup _ _) = True
1372 isDoc _ = False
1373
1374
1375 -------------------------------
1376 check_occs :: IE RdrName -> ExportOccMap -> [Name] -> RnM ExportOccMap
1377 check_occs ie occs names -- 'names' are the entities specifed by 'ie'
1378 = foldlM check occs names
1379 where
1380 check occs name
1381 = case lookupOccEnv occs name_occ of
1382 Nothing -> return (extendOccEnv occs name_occ (name, ie))
1383
1384 Just (name', ie')
1385 | name == name' -- Duplicate export
1386 -- But we don't want to warn if the same thing is exported
1387 -- by two different module exports. See ticket #4478.
1388 -> do unless (dupExport_ok name ie ie') $ do
1389 warn_dup_exports <- woptM Opt_WarnDuplicateExports
1390 warnIf warn_dup_exports (dupExportWarn name_occ ie ie')
1391 return occs
1392
1393 | otherwise -- Same occ name but different names: an error
1394 -> do { global_env <- getGlobalRdrEnv ;
1395 addErr (exportClashErr global_env name' name ie' ie) ;
1396 return occs }
1397 where
1398 name_occ = nameOccName name
1399
1400
1401 dupExport_ok :: Name -> IE RdrName -> IE RdrName -> Bool
1402 -- The Name is exported by both IEs. Is that ok?
1403 -- "No" iff the name is mentioned explicitly in both IEs
1404 -- or one of the IEs mentions the name *alone*
1405 -- "Yes" otherwise
1406 --
1407 -- Examples of "no": module M( f, f )
1408 -- module M( fmap, Functor(..) )
1409 -- module M( module Data.List, head )
1410 --
1411 -- Example of "yes"
1412 -- module M( module A, module B ) where
1413 -- import A( f )
1414 -- import B( f )
1415 --
1416 -- Example of "yes" (Trac #2436)
1417 -- module M( C(..), T(..) ) where
1418 -- class C a where { data T a }
1419 -- instace C Int where { data T Int = TInt }
1420 --
1421 -- Example of "yes" (Trac #2436)
1422 -- module Foo ( T ) where
1423 -- data family T a
1424 -- module Bar ( T(..), module Foo ) where
1425 -- import Foo
1426 -- data instance T Int = TInt
1427
1428 dupExport_ok n ie1 ie2
1429 = not ( single ie1 || single ie2
1430 || (explicit_in ie1 && explicit_in ie2) )
1431 where
1432 explicit_in (IEModuleContents _) = False -- module M
1433 explicit_in (IEThingAll r) = nameOccName n == rdrNameOcc (unLoc r) -- T(..)
1434 explicit_in _ = True
1435
1436 single (IEVar {}) = True
1437 single (IEThingAbs {}) = True
1438 single _ = False
1439
1440 {-
1441 *********************************************************
1442 * *
1443 \subsection{Unused names}
1444 * *
1445 *********************************************************
1446 -}
1447
1448 reportUnusedNames :: Maybe (Located [LIE RdrName]) -- Export list
1449 -> TcGblEnv -> RnM ()
1450 reportUnusedNames _export_decls gbl_env
1451 = do { traceRn ((text "RUN") <+> (ppr (tcg_dus gbl_env)))
1452 ; warnUnusedImportDecls gbl_env
1453 ; warnUnusedTopBinds unused_locals }
1454 where
1455 used_names :: NameSet
1456 used_names = findUses (tcg_dus gbl_env) emptyNameSet
1457 -- NB: currently, if f x = g, we only treat 'g' as used if 'f' is used
1458 -- Hence findUses
1459
1460 -- Collect the defined names from the in-scope environment
1461 defined_names :: [GlobalRdrElt]
1462 defined_names = globalRdrEnvElts (tcg_rdr_env gbl_env)
1463
1464 -- Note that defined_and_used, defined_but_not_used
1465 -- are both [GRE]; that's why we need defined_and_used
1466 -- rather than just used_names
1467 _defined_and_used, defined_but_not_used :: [GlobalRdrElt]
1468 (_defined_and_used, defined_but_not_used)
1469 = partition (gre_is_used used_names) defined_names
1470
1471 kids_env = mkChildEnv defined_names
1472 -- This is done in mkExports too; duplicated work
1473
1474 gre_is_used :: NameSet -> GlobalRdrElt -> Bool
1475 gre_is_used used_names (GRE {gre_name = name})
1476 = name `elemNameSet` used_names
1477 || any (\ gre -> gre_name gre `elemNameSet` used_names) (findChildren kids_env name)
1478 -- A use of C implies a use of T,
1479 -- if C was brought into scope by T(..) or T(C)
1480
1481 -- Filter out the ones that are
1482 -- (a) defined in this module, and
1483 -- (b) not defined by a 'deriving' clause
1484 -- The latter have an Internal Name, so we can filter them out easily
1485 unused_locals :: [GlobalRdrElt]
1486 unused_locals = filter is_unused_local defined_but_not_used
1487 is_unused_local :: GlobalRdrElt -> Bool
1488 is_unused_local gre = isLocalGRE gre && isExternalName (gre_name gre)
1489
1490 {-
1491 *********************************************************
1492 * *
1493 \subsection{Unused imports}
1494 * *
1495 *********************************************************
1496
1497 This code finds which import declarations are unused. The
1498 specification and implementation notes are here:
1499 http://ghc.haskell.org/trac/ghc/wiki/Commentary/Compiler/UnusedImports
1500 -}
1501
1502 type ImportDeclUsage
1503 = ( LImportDecl Name -- The import declaration
1504 , [AvailInfo] -- What *is* used (normalised)
1505 , [Name] ) -- What is imported but *not* used
1506
1507 warnUnusedImportDecls :: TcGblEnv -> RnM ()
1508 warnUnusedImportDecls gbl_env
1509 = do { uses <- readMutVar (tcg_used_gres gbl_env)
1510 ; let user_imports = filterOut (ideclImplicit . unLoc) (tcg_rn_imports gbl_env)
1511 -- This whole function deals only with *user* imports
1512 -- both for warning about unnecessary ones, and for
1513 -- deciding the minimal ones
1514 rdr_env = tcg_rdr_env gbl_env
1515 fld_env = mkFieldEnv rdr_env
1516
1517 ; let usage :: [ImportDeclUsage]
1518 usage = findImportUsage user_imports uses
1519
1520 ; traceRn (vcat [ ptext (sLit "Uses:") <+> ppr uses
1521 , ptext (sLit "Import usage") <+> ppr usage])
1522 ; whenWOptM Opt_WarnUnusedImports $
1523 mapM_ (warnUnusedImport fld_env) usage
1524
1525 ; whenGOptM Opt_D_dump_minimal_imports $
1526 printMinimalImports usage }
1527
1528 {-
1529 Note [The ImportMap]
1530 ~~~~~~~~~~~~~~~~~~~~
1531 The ImportMap is a short-lived intermediate data struture records, for
1532 each import declaration, what stuff brought into scope by that
1533 declaration is actually used in the module.
1534
1535 The SrcLoc is the location of the END of a particular 'import'
1536 declaration. Why *END*? Because we don't want to get confused
1537 by the implicit Prelude import. Consider (Trac #7476) the module
1538 import Foo( foo )
1539 main = print foo
1540 There is an implicit 'import Prelude(print)', and it gets a SrcSpan
1541 of line 1:1 (just the point, not a span). If we use the *START* of
1542 the SrcSpan to identify the import decl, we'll confuse the implicit
1543 import Prelude with the explicit 'import Foo'. So we use the END.
1544 It's just a cheap hack; we could equally well use the Span too.
1545
1546 The AvailInfos are the things imported from that decl (just a list,
1547 not normalised).
1548 -}
1549
1550 type ImportMap = Map SrcLoc [AvailInfo] -- See [The ImportMap]
1551
1552 findImportUsage :: [LImportDecl Name]
1553 -> [GlobalRdrElt]
1554 -> [ImportDeclUsage]
1555
1556 findImportUsage imports used_gres
1557 = map unused_decl imports
1558 where
1559 import_usage :: ImportMap
1560 import_usage
1561 = foldr extendImportMap Map.empty used_gres
1562
1563 unused_decl decl@(L loc (ImportDecl { ideclHiding = imps }))
1564 = (decl, nubAvails used_avails, nameSetElems unused_imps)
1565 where
1566 used_avails = Map.lookup (srcSpanEnd loc) import_usage `orElse` []
1567 -- srcSpanEnd: see Note [The ImportMap]
1568 used_names = availsToNameSetWithSelectors used_avails
1569 used_parents = mkNameSet [n | AvailTC n _ _ <- used_avails]
1570
1571 unused_imps -- Not trivial; see eg Trac #7454
1572 = case imps of
1573 Just (False, L _ imp_ies) ->
1574 foldr (add_unused . unLoc) emptyNameSet imp_ies
1575 _other -> emptyNameSet -- No explicit import list => no unused-name list
1576
1577 add_unused :: IE Name -> NameSet -> NameSet
1578 add_unused (IEVar (L _ n)) acc = add_unused_name n acc
1579 add_unused (IEThingAbs (L _ n)) acc = add_unused_name n acc
1580 add_unused (IEThingAll (L _ n)) acc = add_unused_all n acc
1581 add_unused (IEThingWith (L _ p) wc ns fs) acc =
1582 add_wc_all (add_unused_with p xs acc)
1583 where xs = map unLoc ns ++ map (flSelector . unLoc) fs
1584 add_wc_all = case wc of
1585 NoIEWildcard -> id
1586 IEWildcard _ -> add_unused_all p
1587 add_unused _ acc = acc
1588
1589 add_unused_name n acc
1590 | n `elemNameSet` used_names = acc
1591 | otherwise = acc `extendNameSet` n
1592 add_unused_all n acc
1593 | n `elemNameSet` used_names = acc
1594 | n `elemNameSet` used_parents = acc
1595 | otherwise = acc `extendNameSet` n
1596 add_unused_with p ns acc
1597 | all (`elemNameSet` acc1) ns = add_unused_name p acc1
1598 | otherwise = acc1
1599 where
1600 acc1 = foldr add_unused_name acc ns
1601 -- If you use 'signum' from Num, then the user may well have
1602 -- imported Num(signum). We don't want to complain that
1603 -- Num is not itself mentioned. Hence the two cases in add_unused_with.
1604
1605 extendImportMap :: GlobalRdrElt -> ImportMap -> ImportMap
1606 -- For each of a list of used GREs, find all the import decls that brought
1607 -- it into scope; choose one of them (bestImport), and record
1608 -- the RdrName in that import decl's entry in the ImportMap
1609 extendImportMap gre imp_map
1610 = add_imp gre (bestImport (gre_imp gre)) imp_map
1611 where
1612 add_imp :: GlobalRdrElt -> ImportSpec -> ImportMap -> ImportMap
1613 add_imp gre (ImpSpec { is_decl = imp_decl_spec }) imp_map
1614 = Map.insertWith add decl_loc [avail] imp_map
1615 where
1616 add _ avails = avail : avails -- add is really just a specialised (++)
1617 decl_loc = srcSpanEnd (is_dloc imp_decl_spec)
1618 -- For srcSpanEnd see Note [The ImportMap]
1619 avail = availFromGRE gre
1620
1621 warnUnusedImport :: NameEnv (FieldLabelString, Name) -> ImportDeclUsage
1622 -> RnM ()
1623 warnUnusedImport fld_env (L loc decl, used, unused)
1624 | Just (False,L _ []) <- ideclHiding decl
1625 = return () -- Do not warn for 'import M()'
1626
1627 | Just (True, L _ hides) <- ideclHiding decl
1628 , not (null hides)
1629 , pRELUDE_NAME == unLoc (ideclName decl)
1630 = return () -- Note [Do not warn about Prelude hiding]
1631 | null used = addWarnAt loc msg1 -- Nothing used; drop entire decl
1632 | null unused = return () -- Everything imported is used; nop
1633 | otherwise = addWarnAt loc msg2 -- Some imports are unused
1634 where
1635 msg1 = vcat [pp_herald <+> quotes pp_mod <+> pp_not_used,
1636 nest 2 (ptext (sLit "except perhaps to import instances from")
1637 <+> quotes pp_mod),
1638 ptext (sLit "To import instances alone, use:")
1639 <+> ptext (sLit "import") <+> pp_mod <> parens Outputable.empty ]
1640 msg2 = sep [pp_herald <+> quotes sort_unused,
1641 text "from module" <+> quotes pp_mod <+> pp_not_used]
1642 pp_herald = text "The" <+> pp_qual <+> text "import of"
1643 pp_qual
1644 | ideclQualified decl = text "qualified"
1645 | otherwise = Outputable.empty
1646 pp_mod = ppr (unLoc (ideclName decl))
1647 pp_not_used = text "is redundant"
1648
1649 ppr_possible_field n = case lookupNameEnv fld_env n of
1650 Just (fld, p) -> ppr p <> parens (ppr fld)
1651 Nothing -> ppr n
1652
1653 -- Print unused names in a deterministic (lexicographic) order
1654 sort_unused = pprWithCommas ppr_possible_field $
1655 sortBy (comparing nameOccName) unused
1656
1657 {-
1658 Note [Do not warn about Prelude hiding]
1659 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1660 We do not warn about
1661 import Prelude hiding( x, y )
1662 because even if nothing else from Prelude is used, it may be essential to hide
1663 x,y to avoid name-shadowing warnings. Example (Trac #9061)
1664 import Prelude hiding( log )
1665 f x = log where log = ()
1666
1667
1668
1669 Note [Printing minimal imports]
1670 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1671 To print the minimal imports we walk over the user-supplied import
1672 decls, and simply trim their import lists. NB that
1673
1674 * We do *not* change the 'qualified' or 'as' parts!
1675
1676 * We do not disard a decl altogether; we might need instances
1677 from it. Instead we just trim to an empty import list
1678 -}
1679
1680 printMinimalImports :: [ImportDeclUsage] -> RnM ()
1681 -- See Note [Printing minimal imports]
1682 printMinimalImports imports_w_usage
1683 = do { imports' <- mapM mk_minimal imports_w_usage
1684 ; this_mod <- getModule
1685 ; dflags <- getDynFlags
1686 ; liftIO $
1687 do { h <- openFile (mkFilename dflags this_mod) WriteMode
1688 ; printForUser dflags h neverQualify (vcat (map ppr imports')) }
1689 -- The neverQualify is important. We are printing Names
1690 -- but they are in the context of an 'import' decl, and
1691 -- we never qualify things inside there
1692 -- E.g. import Blag( f, b )
1693 -- not import Blag( Blag.f, Blag.g )!
1694 }
1695 where
1696 mkFilename dflags this_mod
1697 | Just d <- dumpDir dflags = d </> basefn
1698 | otherwise = basefn
1699 where
1700 basefn = moduleNameString (moduleName this_mod) ++ ".imports"
1701
1702 mk_minimal (L l decl, used, unused)
1703 | null unused
1704 , Just (False, _) <- ideclHiding decl
1705 = return (L l decl)
1706 | otherwise
1707 = do { let ImportDecl { ideclName = L _ mod_name
1708 , ideclSource = is_boot
1709 , ideclPkgQual = mb_pkg } = decl
1710 ; iface <- loadSrcInterface doc mod_name is_boot (fmap sl_fs mb_pkg)
1711 ; let lies = map (L l) (concatMap (to_ie iface) used)
1712 ; return (L l (decl { ideclHiding = Just (False, L l lies) })) }
1713 where
1714 doc = text "Compute minimal imports for" <+> ppr decl
1715
1716 to_ie :: ModIface -> AvailInfo -> [IE Name]
1717 -- The main trick here is that if we're importing all the constructors
1718 -- we want to say "T(..)", but if we're importing only a subset we want
1719 -- to say "T(A,B,C)". So we have to find out what the module exports.
1720 to_ie _ (Avail _ n)
1721 = [IEVar (noLoc n)]
1722 to_ie _ (AvailTC n [m] [])
1723 | n==m = [IEThingAbs (noLoc n)]
1724 to_ie iface (AvailTC n ns fs)
1725 = case [(xs,gs) | AvailTC x xs gs <- mi_exports iface
1726 , x == n
1727 , x `elem` xs -- Note [Partial export]
1728 ] of
1729 [xs] | all_used xs -> [IEThingAll (noLoc n)]
1730 | otherwise -> [IEThingWith (noLoc n) NoIEWildcard
1731 (map noLoc (filter (/= n) ns))
1732 (map noLoc fs)]
1733 -- Note [Overloaded field import]
1734 _other | all_non_overloaded fs
1735 -> map (IEVar . noLoc) $ ns ++ map flSelector fs
1736 | otherwise -> [IEThingWith (noLoc n) NoIEWildcard
1737 (map noLoc (filter (/= n) ns)) (map noLoc fs)]
1738 where
1739 fld_lbls = map flLabel fs
1740
1741 all_used (avail_occs, avail_flds)
1742 = all (`elem` ns) avail_occs
1743 && all (`elem` fld_lbls) (map flLabel avail_flds)
1744
1745 all_non_overloaded = all (not . flIsOverloaded)
1746
1747 {-
1748 Note [Partial export]
1749 ~~~~~~~~~~~~~~~~~~~~~
1750 Suppose we have
1751
1752 module A( op ) where
1753 class C a where
1754 op :: a -> a
1755
1756 module B where
1757 import A
1758 f = ..op...
1759
1760 Then the minimal import for module B is
1761 import A( op )
1762 not
1763 import A( C( op ) )
1764 which we would usually generate if C was exported from B. Hence
1765 the (x `elem` xs) test when deciding what to generate.
1766
1767
1768 Note [Overloaded field import]
1769 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1770 On the other hand, if we have
1771
1772 {-# LANGUAGE DuplicateRecordFields #-}
1773 module A where
1774 data T = MkT { foo :: Int }
1775
1776 module B where
1777 import A
1778 f = ...foo...
1779
1780 then the minimal import for module B must be
1781 import A ( T(foo) )
1782 because when DuplicateRecordFields is enabled, field selectors are
1783 not in scope without their enclosing datatype.
1784
1785
1786 ************************************************************************
1787 * *
1788 \subsection{Errors}
1789 * *
1790 ************************************************************************
1791 -}
1792
1793 qualImportItemErr :: RdrName -> SDoc
1794 qualImportItemErr rdr
1795 = hang (ptext (sLit "Illegal qualified name in import item:"))
1796 2 (ppr rdr)
1797
1798 badImportItemErrStd :: ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
1799 badImportItemErrStd iface decl_spec ie
1800 = sep [ptext (sLit "Module"), quotes (ppr (is_mod decl_spec)), source_import,
1801 ptext (sLit "does not export"), quotes (ppr ie)]
1802 where
1803 source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
1804 | otherwise = Outputable.empty
1805
1806 badImportItemErrDataCon :: OccName -> ModIface -> ImpDeclSpec -> IE RdrName -> SDoc
1807 badImportItemErrDataCon dataType_occ iface decl_spec ie
1808 = vcat [ ptext (sLit "In module")
1809 <+> quotes (ppr (is_mod decl_spec))
1810 <+> source_import <> colon
1811 , nest 2 $ quotes datacon
1812 <+> ptext (sLit "is a data constructor of")
1813 <+> quotes dataType
1814 , ptext (sLit "To import it use")
1815 , nest 2 $ quotes (ptext (sLit "import"))
1816 <+> ppr (is_mod decl_spec)
1817 <> parens_sp (dataType <> parens_sp datacon)
1818 , ptext (sLit "or")
1819 , nest 2 $ quotes (ptext (sLit "import"))
1820 <+> ppr (is_mod decl_spec)
1821 <> parens_sp (dataType <> ptext (sLit "(..)"))
1822 ]
1823 where
1824 datacon_occ = rdrNameOcc $ ieName ie
1825 datacon = parenSymOcc datacon_occ (ppr datacon_occ)
1826 dataType = parenSymOcc dataType_occ (ppr dataType_occ)
1827 source_import | mi_boot iface = ptext (sLit "(hi-boot interface)")
1828 | otherwise = Outputable.empty
1829 parens_sp d = parens (space <> d <> space) -- T( f,g )
1830
1831 badImportItemErr :: ModIface -> ImpDeclSpec -> IE RdrName -> [AvailInfo] -> SDoc
1832 badImportItemErr iface decl_spec ie avails
1833 = case find checkIfDataCon avails of
1834 Just con -> badImportItemErrDataCon (availOccName con) iface decl_spec ie
1835 Nothing -> badImportItemErrStd iface decl_spec ie
1836 where
1837 checkIfDataCon (AvailTC _ ns _) =
1838 case find (\n -> importedFS == nameOccNameFS n) ns of
1839 Just n -> isDataConName n
1840 Nothing -> False
1841 checkIfDataCon _ = False
1842 availOccName = nameOccName . availName
1843 nameOccNameFS = occNameFS . nameOccName
1844 importedFS = occNameFS . rdrNameOcc $ ieName ie
1845
1846 illegalImportItemErr :: SDoc
1847 illegalImportItemErr = ptext (sLit "Illegal import item")
1848
1849 dodgyImportWarn :: RdrName -> SDoc
1850 dodgyImportWarn item = dodgyMsg (ptext (sLit "import")) item
1851 dodgyExportWarn :: Name -> SDoc
1852 dodgyExportWarn item = dodgyMsg (ptext (sLit "export")) item
1853
1854 dodgyMsg :: (OutputableBndr n, HasOccName n) => SDoc -> n -> SDoc
1855 dodgyMsg kind tc
1856 = sep [ ptext (sLit "The") <+> kind <+> ptext (sLit "item")
1857 <+> quotes (ppr (IEThingAll (noLoc tc)))
1858 <+> ptext (sLit "suggests that"),
1859 quotes (ppr tc) <+> ptext (sLit "has (in-scope) constructors or class methods,"),
1860 ptext (sLit "but it has none") ]
1861
1862 exportItemErr :: IE RdrName -> SDoc
1863 exportItemErr export_item
1864 = sep [ ptext (sLit "The export item") <+> quotes (ppr export_item),
1865 ptext (sLit "attempts to export constructors or class methods that are not visible here") ]
1866
1867 exportClashErr :: GlobalRdrEnv -> Name -> Name -> IE RdrName -> IE RdrName
1868 -> MsgDoc
1869 exportClashErr global_env name1 name2 ie1 ie2
1870 = vcat [ ptext (sLit "Conflicting exports for") <+> quotes (ppr occ) <> colon
1871 , ppr_export ie1' name1'
1872 , ppr_export ie2' name2' ]
1873 where
1874 occ = nameOccName name1
1875 ppr_export ie name = nest 3 (hang (quotes (ppr ie) <+> ptext (sLit "exports") <+>
1876 quotes (ppr name))
1877 2 (pprNameProvenance (get_gre name)))
1878
1879 -- get_gre finds a GRE for the Name, so that we can show its provenance
1880 get_gre name
1881 = case lookupGRE_Name global_env name of
1882 (gre:_) -> gre
1883 [] -> pprPanic "exportClashErr" (ppr name)
1884 get_loc name = greSrcSpan (get_gre name)
1885 (name1', ie1', name2', ie2') = if get_loc name1 < get_loc name2
1886 then (name1, ie1, name2, ie2)
1887 else (name2, ie2, name1, ie1)
1888
1889 addDupDeclErr :: [GlobalRdrElt] -> TcRn ()
1890 addDupDeclErr [] = panic "addDupDeclErr: empty list"
1891 addDupDeclErr gres@(gre : _)
1892 = addErrAt (getSrcSpan (last sorted_names)) $
1893 -- Report the error at the later location
1894 vcat [ptext (sLit "Multiple declarations of") <+>
1895 quotes (ppr (nameOccName name)),
1896 -- NB. print the OccName, not the Name, because the
1897 -- latter might not be in scope in the RdrEnv and so will
1898 -- be printed qualified.
1899 ptext (sLit "Declared at:") <+>
1900 vcat (map (ppr . nameSrcLoc) sorted_names)]
1901 where
1902 name = gre_name gre
1903 sorted_names = sortWith nameSrcLoc (map gre_name gres)
1904
1905 dupExportWarn :: OccName -> IE RdrName -> IE RdrName -> SDoc
1906 dupExportWarn occ_name ie1 ie2
1907 = hsep [quotes (ppr occ_name),
1908 ptext (sLit "is exported by"), quotes (ppr ie1),
1909 ptext (sLit "and"), quotes (ppr ie2)]
1910
1911 dupModuleExport :: ModuleName -> SDoc
1912 dupModuleExport mod
1913 = hsep [ptext (sLit "Duplicate"),
1914 quotes (ptext (sLit "Module") <+> ppr mod),
1915 ptext (sLit "in export list")]
1916
1917 moduleNotImported :: ModuleName -> SDoc
1918 moduleNotImported mod
1919 = ptext (sLit "The export item `module") <+> ppr mod <>
1920 ptext (sLit "' is not imported")
1921
1922 nullModuleExport :: ModuleName -> SDoc
1923 nullModuleExport mod
1924 = ptext (sLit "The export item `module") <+> ppr mod <> ptext (sLit "' exports nothing")
1925
1926 missingImportListWarn :: ModuleName -> SDoc
1927 missingImportListWarn mod
1928 = ptext (sLit "The module") <+> quotes (ppr mod) <+> ptext (sLit "does not have an explicit import list")
1929
1930 missingImportListItem :: IE RdrName -> SDoc
1931 missingImportListItem ie
1932 = ptext (sLit "The import item") <+> quotes (ppr ie) <+> ptext (sLit "does not have an explicit import list")
1933
1934 moduleWarn :: ModuleName -> WarningTxt -> SDoc
1935 moduleWarn mod (WarningTxt _ txt)
1936 = sep [ ptext (sLit "Module") <+> quotes (ppr mod) <> ptext (sLit ":"),
1937 nest 2 (vcat (map (ppr . sl_fs . unLoc) txt)) ]
1938 moduleWarn mod (DeprecatedTxt _ txt)
1939 = sep [ ptext (sLit "Module") <+> quotes (ppr mod)
1940 <+> ptext (sLit "is deprecated:"),
1941 nest 2 (vcat (map (ppr . sl_fs . unLoc) txt)) ]
1942
1943 packageImportErr :: SDoc
1944 packageImportErr
1945 = ptext (sLit "Package-qualified imports are not enabled; use PackageImports")
1946
1947 -- This data decl will parse OK
1948 -- data T = a Int
1949 -- treating "a" as the constructor.
1950 -- It is really hard to make the parser spot this malformation.
1951 -- So the renamer has to check that the constructor is legal
1952 --
1953 -- We can get an operator as the constructor, even in the prefix form:
1954 -- data T = :% Int Int
1955 -- from interface files, which always print in prefix form
1956
1957 checkConName :: RdrName -> TcRn ()
1958 checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
1959
1960 badDataCon :: RdrName -> SDoc
1961 badDataCon name
1962 = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]