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