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