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