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