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