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